File: 20-simple.t

package info (click to toggle)
libgit-repository-perl 1.325-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 376 kB
  • sloc: perl: 661; makefile: 7
file content (370 lines) | stat: -rw-r--r-- 10,970 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
use strict;
use warnings;
use Test::More;
use Test::Requires::Git;
use Test::Git;
use File::Temp qw( tempdir );
use File::Spec;
use Cwd qw( cwd abs_path );
use Git::Repository;

test_requires_git '1.5.5';

my $version = Git::Repository->version;

plan tests => my $tests;

# clean up the environment
delete @ENV{qw( GIT_DIR GIT_WORK_TREE )};
$ENV{LC_ALL}              = 'C';
$ENV{GIT_AUTHOR_NAME}     = 'Test Author';
$ENV{GIT_AUTHOR_EMAIL}    = 'test.author@example.com';
$ENV{GIT_COMMITTER_NAME}  = 'Test Committer';
$ENV{GIT_COMMITTER_EMAIL} = 'test.committer@example.com';
$ENV{GIT_CONFIG_NOSYSTEM} = 1;
delete $ENV{XDG_CONFIG_HOME};
delete $ENV{HOME};
my $home = cwd;

local $/ = chr rand 128;

# small helper sub
sub update_file {
    my ( $file, $content ) = @_;
    open my $fh, '>', $file or die "Can't open $file: $!";
    print {$fh} $content;
    close $fh;
}

# a place to put a git repository
my $dir = abs_path( tempdir( CLEANUP => 1 ) );

# a quiet git init:
my @init = qw( init );
push @init, '-q' if Git::Repository->version_ge('1.5.2.3');

# PASS - non-existent directory
BEGIN { $tests += 3 }
chdir $dir;
Git::Repository->run( @init );
my $r = Git::Repository->new();
isa_ok( $r, 'Git::Repository' );
chdir $home;

is( $r->work_tree, $dir, 'work tree' );

my $gitdir = $r->run( qw( rev-parse --git-dir ) );
$gitdir = File::Spec->catfile( $dir, $gitdir )
    if ! File::Spec->file_name_is_absolute( $gitdir );
is( $gitdir, $r->git_dir, 'git-dir' );

# check usage exit code
BEGIN { $tests += 2 }
ok( ! eval { $r->run( qw( commit --bonk ) ); }, "FAIL with usage text" );
like( $@, qr/^usage: .*?git[- ]commit/m, '... expected usage message' );

# add file to the index
update_file( File::Spec->catfile( $dir, 'readme.txt' ), << 'TXT' );
Some readme text
for our example
TXT

$r->run( add => 'readme.txt' );

# unset all editors
delete @ENV{qw( EDITOR VISUAL GIT_EDITOR )};

SKIP: {
    BEGIN { $tests += 2 }
    skip "these tests require git >= 1.6.6, but we only have $version", 2
        if Git::Repository->version_lt('1.6.6');

    skip "editor defined directly in .gitconfig", 2
        if $r->run( config => 'core.editor' );

    skip "this test does not work with msysgit on Win32", 2
        if $^O eq 'MSWin32';

    skip "'git var GIT_EDITOR' behaviour was changed in git 2.40.0, and we have $version", 2
        if Git::Repository->version_ge('2.40.0');

    ok( !eval { $r->run( var => 'GIT_EDITOR' ); 1; }, 'git var GIT_EDITOR' );
    like(
        $@,
        qr/^fatal: Terminal is dumb, but EDITOR unset /,
        'Git complains about lack of smarts and editor'
    );
}

# with git commit it's not fatal
BEGIN { $tests += 4 }
SKIP: {
    skip "editor defined directly in .gitconfig", 4
        if $r->run( config => 'core.editor' );

    skip "this test does not work with msysgit on Win32", 4
        if $^O eq 'MSWin32';

    ok( my $cmd = $r->command('commit', '--no-verify'), 'git commit' );
    isa_ok( $cmd, 'Git::Repository::Command' );
    local $/ = "\n";
    my $error = $cmd->stderr->getline;
    my $git = Git::Repository::Command::_is_git('git');
    is_deeply( [ $cmd->cmdline ], [ $git, 'commit', '--no-verify' ], 'command-line' );
    $cmd->close;
    like(
        $error,
        qr/^(?:error: )?Terminal is dumb/,
        'Git complains about lack of smarts and editor'
    );
}

# commit again
BEGIN { $tests += 1 }
my $message = 'a readme file';
$r->run( commit => '-m', $message );

my @log = $r->run( log => '--pretty=format:%s' );
is_deeply( \@log, [$message], 'git commit ; git log' );

# test callbacks
BEGIN { $tests += 2 }
@log = $r->run( log => '--pretty=format:%s', sub { ~~ reverse } );
is_deeply( \@log, [ ~~ reverse $message ], 'run() with 1 callback' );

sub rot13 { $_[0] =~ y/a-z/n-za-m/; $_[0] }
@log = $r->run( log => '--pretty=format:%s', \&rot13, sub { ~~ reverse } );
is_deeply( \@log, [ ~~ reverse rot13 $message ], 'run() with 2 callback' );

# use commit-tree with input option
BEGIN { $tests += 4 }
my $parent = $r->run( log => '--pretty=format:%H' );
like( $parent, qr/^[a-f0-9]{40}$/, 'parent commit id' );
my $tree = $r->run( log => '--pretty=format:%T' );
like( $parent, qr/^[a-f0-9]{40}$/, 'parent tree id' );

my $commit;
$commit = $r->run(
    'commit-tree' => $tree,
    '-p',
    $parent,
    { input => "$message $tree" },
);
like( $commit, qr/^[a-f0-9]{40}$/, 'new commit id' );
cmp_ok( $commit, 'ne', $parent, 'new commit id is different from parent id' );
$r->run( reset => $commit );

# process "long" output
BEGIN { $tests += 3 }
{
    my $lines;
    my $cmd = $r->command( log => '--pretty=oneline', '--all' );
    isa_ok( $cmd, 'Git::Repository::Command' );
    my $git = Git::Repository::Command::_is_git('git');
    is_deeply( [ $cmd->cmdline ], [ $git, qw( log --pretty=oneline --all ) ], 'command-line' );
    my $log = $cmd->stdout;
    local $/ = "\n";
    while (<$log>) {
        $lines++;
    }
    is( $lines, 2, 'git log' );

    # no call to close, we count on DESTROY
}

# use command as a class method, with cwd option
BEGIN { $tests += 2 }
{
    my $cmd = Git::Repository->command(
        { cwd => $dir },
        log => '-1',
        '--pretty=format:%H'
    );
    isa_ok( $cmd, 'Git::Repository::Command' );
    local $/ = "\n";
    my $line = $cmd->stdout->getline();
    chomp $line;
    is( $line, $commit, 'git log -1' );
}

# use command as a class method, with env option
BEGIN { $tests += 2 }
{
    my $cmd = Git::Repository->command(
        { env => { GIT_DIR => $gitdir } },
        log => '-1',
        '--pretty=format:%H'
    );
    isa_ok( $cmd, 'Git::Repository::Command' );
    local $/ = "\n";
    my $line = $cmd->stdout->getline();
    chomp $line;
    is( $line, $commit, 'git log -1' );
    $cmd->stdout->close;
    $cmd->stderr->close;
}

# FAIL - run a command in a non-existent directory
BEGIN { $tests += 2 }
ok( !eval {
        $r->run(
            log => '-1',
            { cwd => File::Spec->catdir( $dir, 'not-there' ) },
            bless( {}, 'Foo' )    # will be ignored silently
        );
    },
    'Fail with option { cwd => non-existent dir }'
);
like( $@, qr/^Can't chdir to .*not-there/, '... expected error message' );

# FAIL - pass more than one Git::Repository to Git::Repository::Command
BEGIN { $tests += 2 }
ok( !eval {
        $r->run( 'version',
            bless( { work_tree => 'TEH FAIL' }, 'Git::Repository' ) );
    },
    'Fail with more than one Git::Repository object'
);
like(
    $@,
    qr/^Too many Git::Repository objects given: /,
    '... expected error message'
);

# now work with GIT_DIR and GIT_WORK_TREE only
BEGIN { $tests += 1 }
{
    local %ENV = %ENV;
    $ENV{GIT_DIR} = $gitdir;

    my $got = Git::Repository->run( log => '-1', '--pretty=format:%H' );
    is( $got, $commit, 'git log -1' );
}

# PASS - try with a relative dir
BEGIN { $tests += 3 }
chdir $dir;
$r = Git::Repository->new( work_tree => '.' );
isa_ok( $r, 'Git::Repository' );
chdir $home;

is( $r->work_tree, $dir, 'work tree' );
is( $r->git_dir, $gitdir, 'git dir' );

# PASS - try with a no dir
BEGIN { $tests += 3 }
chdir $dir;
$r = Git::Repository->new();
isa_ok( $r, 'Git::Repository' );
chdir $home;

is( $r->work_tree,   $dir,    'work tree' );
is( $r->git_dir, $gitdir, 'git dir' );

# PASS - pass the git binary as an option to new()
BEGIN { $tests += 9 }
{
    my $abs_git = File::Spec->rel2abs( Git::Repository::Command::_which('git') );

    # produce a minimal PATH, but
    # - keep the Windows PATH (MSWin32)
    # - keep the directory containing `pwd` (Unix)
    my $path_sep = $Config::Config{path_sep};
    local $ENV{PATH} = join $path_sep,
        $^O eq 'MSWin32'
        ? grep { /\Q$ENV{SYSTEMROOT}\E/ }              split $path_sep, $ENV{PATH}
        : grep { -x File::Spec->catfile( $_, 'pwd' ) } split $path_sep, $ENV{PATH};

    $r = Git::Repository->new( git_dir => $gitdir, { git => $abs_git } );
    isa_ok( $r, 'Git::Repository' );
    is( $r->work_tree, $dir,    'work tree (git_dir, no PATH, git option)' );
    is( $r->git_dir,   $gitdir, 'git dir (git_dir, no PATH, git option)' );

    $r = Git::Repository->new( work_tree => $dir, { git => $abs_git } );
    isa_ok( $r, 'Git::Repository' );
    is( $r->work_tree, $dir, 'work tree (work_tree, no PATH, git option)' );
    is( $r->git_dir, $gitdir, 'git dir (work_tree, no PATH, git option)' );

    chdir $dir;
    $r = Git::Repository->new( { git => $abs_git } );
    isa_ok( $r, 'Git::Repository' );
    chdir $home;
    is( $r->work_tree, $dir,    'work tree (no PATH, git option)' );
    is( $r->git_dir,   $gitdir, 'git dir (no PATH, git option)' );
}

# PASS - use an option HASH
BEGIN { $tests += 3 }
is( Git::Repository->options(), undef, 'No options on the class' );
$r = Git::Repository->new(
    work_tree => $dir,
    {   env => {
            GIT_AUTHOR_NAME  => 'Example author',
            GIT_AUTHOR_EMAIL => 'author@example.com'
        }
    },
);
update_file( my $file = File::Spec->catfile( $dir, 'other.txt' ), << 'TXT' );
Some other text
forcing an author
TXT
$r->run( add => $file );
$r->run( commit => '-m', 'Test option hash in new()' );
my ($author) = grep {/^Author:/} $r->run( log => '-1', '--pretty=medium' );
is( $author,
    'Author: Example author <author@example.com>',
    'Option hash in new()'
);

update_file( $file, << 'TXT' );
Some other text
forcing another author
TXT
$r->run(
    commit => '-a',
    '-m', 'Test option hash in run()',
    { env => { GIT_AUTHOR_EMAIL => 'fail@fail.com' } },      # ignored silently
    { env => { GIT_AUTHOR_EMAIL => 'example@author.com' } }  # not ignored
);
($author) = grep {/^Author:/} $r->run( log => '-1', '--pretty=medium' );
is( $author,
    'Author: Example author <example@author.com>',
    'Option hash in new() and run()'
);

# FAIL - use more than one option HASH
BEGIN { $tests += 2 }
ok( !eval {
        $r = Git::Repository->new(
            work_tree => $dir,
            { env => { GIT_AUTHOR_NAME => 'Example author' } },
            { git => '/bin/false' }
        );
    },
    'new() dies when given more than one option HASH'
);
like( $@, qr/^Too many option hashes given: /, '... expected error message' );

# PASS - use an option HASH (no env key)
BEGIN { $tests += 2 }
( $parent, $tree ) = split /-/, $r->run( log => '--pretty=format:%H-%T', -1 );
ok( $r = eval {
        Git::Repository->new(
            work_tree => $dir,
            { input => 'a dumb way to set log message' },
        );
    },
    'Git::Repository->new()'
);

$commit = $r->run( 'commit-tree', $tree, '-p', $parent );
my $log = $r->run( log => '--pretty=format:%s', -1, $commit, { input => undef } );
is( $log, 'a dumb way to set log message', 'Option hash in new() worked' );

# PASS - create the empty tree
BEGIN { $tests += 2 }
ok( $r = eval { Git::Repository->new( work_tree => $dir ) },
    'Git::Repository->new()' );
$tree = $r->run( mktree => { input => '' } );
is( $tree, '4b825dc642cb6eb9a060e54bf8d69288fbee4904', 'mktree empty tree' );