The make for perl is now retrieved from Perl's config. The make fragment in perl/Makefile.PL added in MY::postamble is disabled on Win32, as it relies on GNU make syntax, and Win32 users are not likely to have an ancient EU::MM version. A Windows path for PERL_PATH is now supported as well, e.g.: make PERL_PATH=C:\\Perl\\bin\\perl or from cmd.exe: make PERL_PATH=C:\Perl\bin\perl . t9700-perl-git.sh now passes on ActiveState Perl. Some tweaks were necessary in Git.pm: a more correct check for absolute directory, exit code check on closing the "pipe", and always closing the cat_blob bidirectional pipe (with errors ignored) so as not to leave zombie processes. The waitpid call on closing the bidirectional pipe is now timed and the process is killed if necessary. Also added some binmode calls to t/t9700/test.pl to make the blob tests pass. Signed-off-by: Rafael Kitover <rkitover@xxxxxxxx> --- Makefile | 8 ++++---- perl/Git.pm | 40 +++++++++++++++++++++++++++++++--------- perl/Makefile | 14 ++++++++++++-- perl/Makefile.PL | 7 ++++++- t/t9700/test.pl | 15 ++++++++++++++- 5 files changed, 67 insertions(+), 17 deletions(-) diff --git a/Makefile b/Makefile index d3dcfb1..3465ab5 100644 --- a/Makefile +++ b/Makefile @@ -175,7 +175,7 @@ all:: # will work. # # Define NO_PERL_MAKEMAKER if you cannot use Makefiles generated by perl's -# MakeMaker (e.g. using ActiveState under Cygwin). +# MakeMaker. # # Define NO_PERL if you do not want Perl scripts or libraries at all. # @@ -1059,7 +1059,7 @@ ifeq ($(uname_S),Windows) NO_MKSTEMPS = YesPlease SNPRINTF_RETURNS_BOGUS = YesPlease NO_SVN_TESTS = YesPlease - NO_PERL_MAKEMAKER = YesPlease + # NO_PERL_MAKEMAKER = YesPlease RUNTIME_PREFIX = YesPlease NO_POSIX_ONLY_PROGRAMS = YesPlease NO_ST_BLOCKS_IN_STRUCT_STAT = YesPlease @@ -1112,7 +1112,7 @@ ifneq (,$(findstring MINGW,$(uname_S))) NO_MKDTEMP = YesPlease NO_MKSTEMPS = YesPlease NO_SVN_TESTS = YesPlease - NO_PERL_MAKEMAKER = YesPlease + # NO_PERL_MAKEMAKER = YesPlease RUNTIME_PREFIX = YesPlease NO_POSIX_ONLY_PROGRAMS = YesPlease NO_ST_BLOCKS_IN_STRUCT_STAT = YesPlease @@ -1652,7 +1652,7 @@ perl/perl.mak: GIT-CFLAGS perl/Makefile perl/Makefile.PL $(patsubst %.perl,%,$(SCRIPT_PERL)): % : %.perl $(QUIET_GEN)$(RM) $@ $@+ && \ - INSTLIBDIR=`MAKEFLAGS= $(MAKE) -C perl -s --no-print-directory instlibdir` && \ + INSTLIBDIR=`MAKEFLAGS= $(MAKE) -C perl -s --no-print-directory instlibdir | sed -e 's/\\\\/\\\\\\\\/g' -e "s/'//g"` && \ sed -e '1{' \ -e ' s|#!.*perl|#!$(PERL_PATH_SQ)|' \ -e ' h' \ diff --git a/perl/Git.pm b/perl/Git.pm index 6cb0dd1..f7d99bd 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -101,6 +101,7 @@ use Error qw(:try); use Cwd qw(abs_path); use IPC::Open2 qw(open2); use Fcntl qw(SEEK_SET SEEK_CUR); +use File::Spec (); } @@ -184,7 +185,8 @@ sub repository { }; if ($dir) { - $dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir; + File::Spec->file_name_is_absolute($dir) + or $dir = $opts{Directory} . '/' . $dir; $opts{Repository} = abs_path($dir); # If --git-dir went ok, this shouldn't die either. @@ -420,7 +422,15 @@ have more complicated structure. sub command_close_bidi_pipe { local $?; - my ($pid, $in, $out, $ctx) = @_; + my ($pid, $in, $out, $ctx, $ignore_errors) = @_; + + if ($ignore_errors) { + close $in; + close $out; + kill -9, $pid; + return; + } + foreach my $fh ($in, $out) { unless (close $fh) { if ($!) { @@ -431,7 +441,14 @@ sub command_close_bidi_pipe { } } - waitpid $pid, 0; + { + local $SIG{ALRM} = sub { + kill -9, $pid; + }; + alarm 1; + waitpid $pid, 0; + alarm 0; + } if ($? >> 8) { throw Git::Error::Command($ctx, $? >>8); @@ -876,11 +893,13 @@ sub cat_blob { my $description = <$in>; if ($description =~ / missing$/) { + $self->_close_cat_blob(); carp "$sha1 doesn't exist in the repository"; return -1; } if ($description !~ /^[0-9a-fA-F]{40} \S+ (\d+)$/) { + $self->_close_cat_blob(); carp "Unexpected result returned from git cat-file"; return -1; } @@ -921,6 +940,8 @@ sub cat_blob { throw Error::Simple("couldn't write to passed in filehandle"); } + $self->_close_cat_blob; + return $size; } @@ -941,7 +962,7 @@ sub _close_cat_blob { my @vars = map { 'cat_blob_' . $_ } qw(pid in out ctx); - command_close_bidi_pipe(@$self{@vars}); + command_close_bidi_pipe(@$self{@vars}, 1); delete @$self{@vars}; } @@ -1300,16 +1321,16 @@ sub _cmd_close { if ($!) { # It's just close, no point in fatalities carp "error closing pipe: $!"; - } elsif ($? >> 8) { - # The caller should pepper this. - throw Git::Error::Command($ctx, $? >> 8); - } + } # else we might e.g. closed a live stream; the command # dying of SIGPIPE would drive us here. } + if ($? >> 8) { + # The caller should pepper this. + throw Git::Error::Command($ctx, $? >> 8); + } } - sub DESTROY { my ($self) = @_; $self->_close_hash_and_insert_object(); @@ -1360,3 +1381,4 @@ sub EOF { 1; # Famous last words +# vim:noet ts=8 sw=8 sts=8: diff --git a/perl/Makefile b/perl/Makefile index a2ffb64..1fa99cd 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -3,18 +3,28 @@ # makfile:=perl.mak +# support PERL_PATH=C:\\Perl\\bin\\perl +PERL_PATH := $(subst \,\\,$(PERL_PATH)) + PERL_PATH_SQ = $(subst ','\'',$(PERL_PATH)) +PERL_MAKE := MAKEFLAGS="" $(subst \,\\,$(shell $(subst \,\\,$(PERL_PATH)) -MConfig -le "print ((\%Config)->{make})")) + +ifneq (,$(findstring nmake,$(PERL_MAKE))) + PERL_MAKE := $(PERL_MAKE) -nologo +endif + prefix_SQ = $(subst ','\'',$(prefix)) ifndef V QUIET = @ endif + all install instlibdir: $(makfile) - $(QUIET)$(MAKE) -f $(makfile) $@ + $(QUIET)$(PERL_MAKE) -f $(makfile) $@ clean: - $(QUIET)test -f $(makfile) && $(MAKE) -f $(makfile) $@ || exit 0 + $(QUIET)test -f $(makfile) && ($(PERL_MAKE) -f $(makfile) $@) || exit 0 $(RM) ppport.h $(RM) $(makfile) $(RM) $(makfile).old diff --git a/perl/Makefile.PL b/perl/Makefile.PL index 0b9deca..7ceec50 100644 --- a/perl/Makefile.PL +++ b/perl/Makefile.PL @@ -1,10 +1,13 @@ use ExtUtils::MakeMaker; sub MY::postamble { - return <<'MAKE_FRAG'; + my $make_frag = <<'MAKE_FRAG'; instlibdir: @echo '$(INSTALLSITELIB)' +MAKE_FRAG + + $make_frag .= <<'MAKE_FRAG' if $^O ne 'MSWin32'; ifneq (,$(DESTDIR)) ifeq (0,$(shell expr '$(MM_VERSION)' '>' 6.10)) $(error ExtUtils::MakeMaker version "$(MM_VERSION)" is older than 6.11 and so \ @@ -14,6 +17,8 @@ endif endif MAKE_FRAG + + return $make_frag; } my %pm = ('Git.pm' => '$(INST_LIBDIR)/Git.pm'); diff --git a/t/t9700/test.pl b/t/t9700/test.pl index 671f38d..d5328a3 100755 --- a/t/t9700/test.pl +++ b/t/t9700/test.pl @@ -1,4 +1,12 @@ #!/usr/bin/perl + +BEGIN { + use Cwd 'abs_path'; + my $perl_dir = abs_path('../../perl'); + eval "use lib '${perl_dir}/blib/lib';"; + eval "use lib '${perl_dir}/blib/arch/auto/Git';"; +} + use lib (split(/:/, $ENV{GITPERLLIB})); use 5.006002; @@ -74,6 +82,7 @@ is($r->ident_person("Name", "email", "123 +0000"), "Name <email>", ok(our $file1hash = $r->command_oneline('rev-parse', "HEAD:file1"), "(get file hash)"); my $tmpfile = "file.tmp"; open TEMPFILE, "+>$tmpfile" or die "Can't open $tmpfile: $!"; +binmode TEMPFILE; is($r->cat_blob($file1hash, \*TEMPFILE), 15, "cat_blob: size"); our $blobcontents; { local $/; seek TEMPFILE, 0, 0; $blobcontents = <TEMPFILE>; } @@ -81,11 +90,13 @@ is($blobcontents, "changed file 1\n", "cat_blob: data"); close TEMPFILE or die "Failed writing to $tmpfile: $!"; is(Git::hash_object("blob", $tmpfile), $file1hash, "hash_object: roundtrip"); open TEMPFILE, ">$tmpfile" or die "Can't open $tmpfile: $!"; +binmode TEMPFILE; print TEMPFILE my $test_text = "test blob, to be inserted\n"; close TEMPFILE or die "Failed writing to $tmpfile: $!"; like(our $newhash = $r->hash_and_insert_object($tmpfile), qr/[0-9a-fA-F]{40}/, "hash_and_insert_object: returns hash"); open TEMPFILE, "+>$tmpfile" or die "Can't open $tmpfile: $!"; +binmode TEMPFILE; is($r->cat_blob($newhash, \*TEMPFILE), length $test_text, "cat_blob: roundtrip size"); { local $/; seek TEMPFILE, 0, 0; $blobcontents = <TEMPFILE>; } is($blobcontents, $test_text, "cat_blob: roundtrip data"); @@ -115,5 +126,7 @@ isnt($last_commit, $dir_commit, 'log . does not show last commit'); printf "1..%d\n", Test::More->builder->current_test; -my $is_passing = eval { Test::More->is_passing }; +my $is_passing = eval { Test::More->builder->is_passing } + || eval { Test::More->is_passing }; exit($is_passing ? 0 : 1) unless $@ =~ /Can't locate object method/; +# vim:noet ts=8 sw=8 sts=8: -- 1.7.3.1.msysgit.0.1.g49f6d.dirty -- To unsubscribe from this list: send the line "unsubscribe git" in the body of a message to majordomo@xxxxxxxxxxxxxxx More majordomo info at http://vger.kernel.org/majordomo-info.html