t/git.t

   1 # Copyright (C) 2015 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ (https://www.gnu.org/licenses/agpl-3.0.txt)
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 use File::Temp qw/tempdir/;
   7 my $dir = tempdir('pi-git-XXXXXX', TMPDIR => 1, CLEANUP => 1);
   8 use Cwd qw/getcwd/;
   9
  10 use_ok 'PublicInbox::Git';
  11 {
  12         is(system(qw(git init -q --bare), $dir), 0, 'created git directory');
  13         my @cmd = ('git', "--git-dir=$dir", 'fast-import', '--quiet');
  14
  15         my $fi_data = getcwd().'/t/git.fast-import-data';
  16         ok(-r $fi_data, "fast-import data readable (or run test at top level)");
  17         my $pid = fork;
  18         defined $pid or die "fork failed: $!\n";
  19         if ($pid == 0) {
  20                 open STDIN, '<', $fi_data or die "open $fi_data: $!\n";
  21                 exec @cmd;
  22                 die "failed exec: ",join(' ', @cmd),": $!\n";
  23         }
  24         waitpid $pid, 0;
  25         is($?, 0, 'fast-import succeeded');
  26 }
  27
  28 {
  29         my $gcf = PublicInbox::Git->new($dir);
  30         my $f = 'HEAD:foo.txt';
  31         my @x = $gcf->check($f);
  32         is(scalar @x, 3, 'returned 3 element array for existing file');
  33         like($x[0], qr/\A[a-f0-9]{40}\z/, 'returns obj ID in 1st element');
  34         is('blob', $x[1], 'returns obj type in 2nd element');
  35         like($x[2], qr/\A\d+\z/, 'returns obj size in 3rd element');
  36
  37         my $raw = $gcf->cat_file($f);
  38         is($x[2], length($$raw), 'length matches');
  39
  40         {
  41                 my $size;
  42                 my $rv = $gcf->cat_file($f, sub {
  43                         my ($in, $left) = @_;
  44                         $size = $$left;
  45                         'nothing'
  46                 });
  47                 is($rv, 'nothing', 'returned from callback without reading');
  48                 is($size, $x[2], 'set size for callback correctly');
  49         }
  50
  51         eval { $gcf->cat_file($f, sub { die 'OMG' }) };
  52         like($@, qr/\bOMG\b/, 'died in callback propagated');
  53         is(${$gcf->cat_file($f)}, $$raw, 'not broken after failures');
  54
  55         {
  56                 my ($buf, $r);
  57                 my $rv = $gcf->cat_file($f, sub {
  58                         my ($in, $left) = @_;
  59                         $r = read($in, $buf, 2);
  60                         $$left -= $r;
  61                         'blah'
  62                 });
  63                 is($r, 2, 'only read 2 bytes');
  64                 is($buf, '--', 'partial read succeeded');
  65                 is($rv, 'blah', 'return value propagated');
  66         }
  67         is(${$gcf->cat_file($f)}, $$raw, 'not broken after partial read');
  68 }
  69
  70 if (1) {
  71         use POSIX qw(dup2);
  72         my @cmd = ('git', "--git-dir=$dir", qw(hash-object -w --stdin));
  73
  74         # need a big file, use the AGPL-3.0 :p
  75         my $big_data = getcwd().'/COPYING';
  76         ok(-r $big_data, 'COPYING readable');
  77         my $size = -s $big_data;
  78         ok($size > 8192, 'file is big enough');
  79
  80         my ($r, $w);
  81         ok(pipe($r, $w), 'created pipe');
  82
  83         my $pid = fork;
  84         defined $pid or die "fork failed: $!\n";
  85         if ($pid == 0) {
  86                 close $r;
  87                 open STDIN, '<', $big_data or die "open $big_data: $!\n";
  88                 dup2(fileno($w), 1);
  89                 exec @cmd;
  90                 die "failed exec: ",join(' ', @cmd),": $!\n";
  91         }
  92         close $w;
  93         my $n = read $r, my $buf, 41;
  94         waitpid $pid, 0;
  95         is(0, $?, 'hashed object successfully');
  96         chomp $buf;
  97
  98         my $gcf = PublicInbox::Git->new($dir);
  99         my $rsize;
 100         is($gcf->cat_file($buf, sub {
 101                 $rsize = ${$_[1]};
 102                 'x';
 103         }), 'x', 'checked input');
 104         is($rsize, $size, 'got correct size on big file');
 105
 106         my $x = $gcf->cat_file($buf, \$rsize);
 107         is($rsize, $size, 'got correct size ref on big file');
 108         is(length($$x), $size, 'read correct number of bytes');
 109
 110         my $rline;
 111         $gcf->cat_file($buf, sub {
 112                 my ($in, $left) = @_;
 113                 $rline = <$in>;
 114                 $$left -= length($rline);
 115         });
 116         {
 117                 open my $fh, '<', $big_data or die "open failed: $!\n";
 118                 is($rline, <$fh>, 'first line matches');
 119         };
 120
 121         my $all;
 122         $gcf->cat_file($buf, sub {
 123                 my ($in, $left) = @_;
 124                 my $x = read($in, $all, $$left);
 125                 $$left -= $x;
 126         });
 127         {
 128                 open my $fh, '<', $big_data or die "open failed: $!\n";
 129                 local $/;
 130                 is($all, <$fh>, 'entire read matches');
 131         };
 132
 133         my $ref = $gcf->qx(qw(cat-file blob), $buf);
 134         is($all, $ref, 'qx read giant single string');
 135
 136         my @ref = $gcf->qx(qw(cat-file blob), $buf);
 137         is($all, join('', @ref), 'qx returned array when wanted');
 138         my $nl = scalar @ref;
 139         ok($nl > 1, "qx returned array length of $nl");
 140 }
 141
 142 done_testing();