r66256 - in /branches/upstream/libpar-packer-perl/current: ./ inc/Test/Builder/IO/ lib/ lib/PAR/ myldr/ t/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Fri Dec 24 23:03:46 UTC 2010


Author: jawnsy-guest
Date: Fri Dec 24 23:03:26 2010
New Revision: 66256

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66256
Log:
[svn-upgrade] new version libpar-packer-perl (1.008)

Added:
    branches/upstream/libpar-packer-perl/current/inc/Test/Builder/IO/
    branches/upstream/libpar-packer-perl/current/inc/Test/Builder/IO/Scalar.pm
    branches/upstream/libpar-packer-perl/current/t/90-rt59710.t
Modified:
    branches/upstream/libpar-packer-perl/current/ChangeLog
    branches/upstream/libpar-packer-perl/current/MANIFEST
    branches/upstream/libpar-packer-perl/current/MANIFEST.SKIP
    branches/upstream/libpar-packer-perl/current/META.yml
    branches/upstream/libpar-packer-perl/current/Makefile.PL
    branches/upstream/libpar-packer-perl/current/lib/PAR/Packer.pm
    branches/upstream/libpar-packer-perl/current/lib/pp.pm
    branches/upstream/libpar-packer-perl/current/myldr/Makefile.PL
    branches/upstream/libpar-packer-perl/current/myldr/file2c.pl
    branches/upstream/libpar-packer-perl/current/myldr/main.c
    branches/upstream/libpar-packer-perl/current/myldr/mktmpdir.h
    branches/upstream/libpar-packer-perl/current/myldr/static.c
    branches/upstream/libpar-packer-perl/current/t/30-current_exec.t

Modified: branches/upstream/libpar-packer-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/ChangeLog?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/ChangeLog (original)
+++ branches/upstream/libpar-packer-perl/current/ChangeLog Fri Dec 24 23:03:26 2010
@@ -1,3 +1,47 @@
+[Changes for 1.008 - Nov 21, 2010]
+* Bug fixes, etc.
+
+    - RT #61528: bug similar to RT 55994
+      (Windows) relax heuristic to check whether the configured C compiler
+      is actually gcc (Ed Zagar)
+    - RT #61874: Windows: Packed executable handles wildcards different from script
+      myldr/static.c: turn off automatic globbing of process arguments when 
+      building with MingW (Roderich)
+    - RT #62357: .cgi extension not taken as script
+      call into Module::ScanDeps with $Module::ScanDeps::ScanFileRE
+      set to qr/./ so that we don't discriminate against scripts that have
+      an extension other than .pl, .pm, .al or .t (or no extension at all)
+      (Roderich)
+    - RT #63083: pp: Undefined subroutine &DynaLoader::bootstrap called in pp-compiled bianry
+      fix the name where the shared perl DSO ($libperl in myldr/Makefile.PL)
+      is extracted to so that it matches the reference the linker wrote into 
+      $par_exe; heuristic currently only available for Linux (assuming
+      we have GNU binutils installed), but might work on other ELF-based
+      systems, too (Roderich)
+    - t/30-current_exec.t: fix a test failure on Cygwin
+      (cygwin.dll was not on PATH) (Roderich)
+
+[Changes for 1.007 - Sep 9, 2010]
+* Bug fixes, etc.
+    - RT #56582: PAR-packer compilation on Windows XP32 box
+      applied patch from Jean-Michel Male to fix building with
+      Microsoft Visual Studio (Roderich)
+    - RT #50747: (no subject)
+      finally use permissions 0775 in my_mkfile() (Roderich)
+    - require modern Module::Install (chorny)
+      and update Module::Install et al. to version 1.00 (Roderich)
+    - RT #59710: Par-Packer not including all dependencies
+      When cleaning @INC at the end of bootstrapping (just before
+      we run the actual packed script) canonicalize $ENV{PAR_TEMP}
+      before we use it to match elements of @INC.
+      This works around non-canonicalized values (e.g. a trailing slash)
+      for $ENV{TMPDIR} or P_tmpdir (as #define'd in <stdio.h>) 
+      (the latter seen on FreeBSD and OSX) (Roderich)
+    - RT #56020: PAR::Packer and PDF::API2 Unicode::UCD: failed to find UnicodeData.txt
+      that's actually a bug in Module::ScanDeps);
+      bump requirement on Module::ScanDeps to a versionthat has the fix
+      (correct %Preload rule for Unicode::UCD)
+
 [Changes for 1.006 - Jun 26, 2010]
 * Bug fixes, etc.
     - RT #58266: fix "install PAR::Packer failed for strawberry perl 5.12.0.1

Modified: branches/upstream/libpar-packer-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/MANIFEST?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/MANIFEST (original)
+++ branches/upstream/libpar-packer-perl/current/MANIFEST Fri Dec 24 23:03:26 2010
@@ -30,6 +30,7 @@
 inc/parent.pm
 inc/PerlIO.pm
 inc/Test/Builder.pm
+inc/Test/Builder/IO/Scalar.pm
 inc/Test/Builder/Module.pm
 inc/Test/More.pm
 lib/App/Packer/PAR.pm
@@ -76,5 +77,6 @@
 t/20-pp.t
 t/30-current_exec.t
 t/40-packer_cd_option.t
+t/90-rt59710.t
 t/test-proc
 TODO

Modified: branches/upstream/libpar-packer-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/MANIFEST.SKIP?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libpar-packer-perl/current/MANIFEST.SKIP Fri Dec 24 23:03:26 2010
@@ -22,5 +22,7 @@
 ^blibdirs
 \B\.svn\b
 ^debian/
+^_Inline/
+^a\.out$
 ^nohup.out
 ^PAR-Packer-.*

Modified: branches/upstream/libpar-packer-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/META.yml?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/META.yml (original)
+++ branches/upstream/libpar-packer-perl/current/META.yml Fri Dec 24 23:03:26 2010
@@ -25,11 +25,11 @@
   Compress::Zlib: 1.3
   File::Temp: 0.05
   Getopt::ArgvFile: 1.07
-  Module::ScanDeps: 0.96
+  Module::ScanDeps: 0.98
   PAR: 1.000
   PAR::Dist: 0.22
   perl: 5.6.1
 resources:
   license: http://dev.perl.org/licenses/
   repository: http://svn.openfoundry.org/par/PAR-Packer/trunk
-version: 1.006
+version: 1.008

Modified: branches/upstream/libpar-packer-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/Makefile.PL?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/Makefile.PL (original)
+++ branches/upstream/libpar-packer-perl/current/Makefile.PL Fri Dec 24 23:03:26 2010
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 use 5.006001;
 use strict;
-use inc::Module::Install;
+use inc::Module::Install 0.92;
 
 name        'PAR-Packer';
 abstract    'PAR Packager';
@@ -11,7 +11,7 @@
 requires    'File::Temp'        => 0.05;
 requires    'Compress::Zlib'    => ($^O eq 'MSWin32') ? 1.16 : 1.30;
 requires    'Archive::Zip'      => 1.00;
-requires    'Module::ScanDeps'  => 0.96;
+requires    'Module::ScanDeps'  => 0.98;
 requires    'PAR::Dist'         => 0.22;
 requires    'PAR'               => '1.000';
 requires    'Getopt::ArgvFile'  => 1.07;
@@ -110,8 +110,8 @@
     clean_files(@bin) if $par or $cc;
 
     # Do not run 10parl-generation tests in case of a pre built .par (doesn't work)
-    my $pgentest = (!$par and $cc) ? ' t/10-parl-generation.t ' : '';
-    my $tests = qq(t/00-pod.t$pgentest t/20-pp.t t/30-current_exec.t t/40-packer_cd_option.t);
+    my %tests = map { $_ => 1 } <t/*.t>;
+    delete $tests{'t/10-parl-generation.t'} unless (!$par and $cc);
 
     makemaker_args(
         MAN1PODS		=> {
@@ -139,7 +139,7 @@
           ) : (),
         ],
         NEEDS_LINKING	        => 1,
-        test => { TESTS => $tests },
+        test => { TESTS => join(" ", sort keys %tests) },
     );
 }
 

Added: branches/upstream/libpar-packer-perl/current/inc/Test/Builder/IO/Scalar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/inc/Test/Builder/IO/Scalar.pm?rev=66256&op=file
==============================================================================
--- branches/upstream/libpar-packer-perl/current/inc/Test/Builder/IO/Scalar.pm (added)
+++ branches/upstream/libpar-packer-perl/current/inc/Test/Builder/IO/Scalar.pm Fri Dec 24 23:03:26 2010
@@ -1,0 +1,406 @@
+#line 1
+package Test::Builder::IO::Scalar;
+
+
+#line 28
+
+# This is copied code, I don't care.
+##no critic
+
+use Carp;
+use strict;
+use vars qw($VERSION @ISA);
+use IO::Handle;
+
+use 5.005;
+
+### The package version, both in 1.23 style *and* usable by MakeMaker:
+$VERSION = "2.110";
+
+### Inheritance:
+ at ISA = qw(IO::Handle);
+
+#==============================
+
+#line 52
+
+#------------------------------
+
+#line 62
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self = bless \do { local *FH }, $class;
+    tie *$self, $class, $self;
+    $self->open(@_);   ### open on anonymous by default
+    $self;
+}
+sub DESTROY {
+    shift->close;
+}
+
+#------------------------------
+
+#line 87
+
+sub open {
+    my ($self, $sref) = @_;
+
+    ### Sanity:
+    defined($sref) or do {my $s = ''; $sref = \$s};
+    (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar";
+
+    ### Setup:
+    *$self->{Pos} = 0;          ### seek position
+    *$self->{SR}  = $sref;      ### scalar reference
+    $self;
+}
+
+#------------------------------
+
+#line 109
+
+sub opened {
+    *{shift()}->{SR};
+}
+
+#------------------------------
+
+#line 123
+
+sub close {
+    my $self = shift;
+    %{*$self} = ();
+    1;
+}
+
+#line 133
+
+
+
+#==============================
+
+#line 143
+
+
+#------------------------------
+
+#line 153
+
+sub flush { "0 but true" }
+
+#------------------------------
+
+#line 164
+
+sub getc {
+    my $self = shift;
+
+    ### Return undef right away if at EOF; else, move pos forward:
+    return undef if $self->eof;
+    substr(${*$self->{SR}}, *$self->{Pos}++, 1);
+}
+
+#------------------------------
+
+#line 183
+
+sub getline {
+    my $self = shift;
+
+    ### Return undef right away if at EOF:
+    return undef if $self->eof;
+
+    ### Get next line:
+    my $sr = *$self->{SR};
+    my $i  = *$self->{Pos};	        ### Start matching at this point.
+
+    ### Minimal impact implementation!
+    ### We do the fast fast thing (no regexps) if using the
+    ### classic input record separator.
+
+    ### Case 1: $/ is undef: slurp all...
+    if    (!defined($/)) {
+	*$self->{Pos} = length $$sr;
+        return substr($$sr, $i);
+    }
+
+    ### Case 2: $/ is "\n": zoom zoom zoom...
+    elsif ($/ eq "\012") {
+
+        ### Seek ahead for "\n"... yes, this really is faster than regexps.
+        my $len = length($$sr);
+        for (; $i < $len; ++$i) {
+           last if ord (substr ($$sr, $i, 1)) == 10;
+        }
+
+        ### Extract the line:
+        my $line;
+        if ($i < $len) {                ### We found a "\n":
+            $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1);
+            *$self->{Pos} = $i+1;            ### Remember where we finished up.
+        }
+        else {                          ### No "\n"; slurp the remainder:
+            $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos});
+            *$self->{Pos} = $len;
+        }
+        return $line;
+    }
+
+    ### Case 3: $/ is ref to int. Do fixed-size records.
+    ###        (Thanks to Dominique Quatravaux.)
+    elsif (ref($/)) {
+        my $len = length($$sr);
+		my $i = ${$/} + 0;
+		my $line = substr ($$sr, *$self->{Pos}, $i);
+		*$self->{Pos} += $i;
+        *$self->{Pos} = $len if (*$self->{Pos} > $len);
+		return $line;
+    }
+
+    ### Case 4: $/ is either "" (paragraphs) or something weird...
+    ###         This is Graham's general-purpose stuff, which might be
+    ###         a tad slower than Case 2 for typical data, because
+    ###         of the regexps.
+    else {
+        pos($$sr) = $i;
+
+	### If in paragraph mode, skip leading lines (and update i!):
+        length($/) or
+	    (($$sr =~ m/\G\n*/g) and ($i = pos($$sr)));
+
+        ### If we see the separator in the buffer ahead...
+        if (length($/)
+	    ?  $$sr =~ m,\Q$/\E,g          ###   (ordinary sep) TBD: precomp!
+            :  $$sr =~ m,\n\n,g            ###   (a paragraph)
+            ) {
+            *$self->{Pos} = pos $$sr;
+            return substr($$sr, $i, *$self->{Pos}-$i);
+        }
+        ### Else if no separator remains, just slurp the rest:
+        else {
+            *$self->{Pos} = length $$sr;
+            return substr($$sr, $i);
+        }
+    }
+}
+
+#------------------------------
+
+#line 273
+
+sub getlines {
+    my $self = shift;
+    wantarray or croak("can't call getlines in scalar context!");
+    my ($line, @lines);
+    push @lines, $line while (defined($line = $self->getline));
+    @lines;
+}
+
+#------------------------------
+
+#line 294
+
+sub print {
+    my $self = shift;
+    *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : ""));
+    1;
+}
+sub _unsafe_print {
+    my $self = shift;
+    my $append = join('', @_) . $\;
+    ${*$self->{SR}} .= $append;
+    *$self->{Pos}   += length($append);
+    1;
+}
+sub _old_print {
+    my $self = shift;
+    ${*$self->{SR}} .= join('', @_) . $\;
+    *$self->{Pos} = length(${*$self->{SR}});
+    1;
+}
+
+
+#------------------------------
+
+#line 324
+
+sub read {
+    my $self = $_[0];
+    my $n    = $_[2];
+    my $off  = $_[3] || 0;
+
+    my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n);
+    $n = length($read);
+    *$self->{Pos} += $n;
+    ($off ? substr($_[1], $off) : $_[1]) = $read;
+    return $n;
+}
+
+#------------------------------
+
+#line 345
+
+sub write {
+    my $self = $_[0];
+    my $n    = $_[2];
+    my $off  = $_[3] || 0;
+
+    my $data = substr($_[1], $off, $n);
+    $n = length($data);
+    $self->print($data);
+    return $n;
+}
+
+#------------------------------
+
+#line 366
+
+sub sysread {
+  my $self = shift;
+  $self->read(@_);
+}
+
+#------------------------------
+
+#line 380
+
+sub syswrite {
+  my $self = shift;
+  $self->write(@_);
+}
+
+#line 389
+
+
+#==============================
+
+#line 398
+
+
+#------------------------------
+
+#line 408
+
+sub autoflush {}
+
+#------------------------------
+
+#line 419
+
+sub binmode {}
+
+#------------------------------
+
+#line 429
+
+sub clearerr { 1 }
+
+#------------------------------
+
+#line 439
+
+sub eof {
+    my $self = shift;
+    (*$self->{Pos} >= length(${*$self->{SR}}));
+}
+
+#------------------------------
+
+#line 452
+
+sub seek {
+    my ($self, $pos, $whence) = @_;
+    my $eofpos = length(${*$self->{SR}});
+
+    ### Seek:
+    if    ($whence == 0) { *$self->{Pos} = $pos }             ### SEEK_SET
+    elsif ($whence == 1) { *$self->{Pos} += $pos }            ### SEEK_CUR
+    elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos}    ### SEEK_END
+    else                 { croak "bad seek whence ($whence)" }
+
+    ### Fixup:
+    if (*$self->{Pos} < 0)       { *$self->{Pos} = 0 }
+    if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos }
+    return 1;
+}
+
+#------------------------------
+
+#line 476
+
+sub sysseek {
+    my $self = shift;
+    $self->seek (@_);
+}
+
+#------------------------------
+
+#line 490
+
+sub tell { *{shift()}->{Pos} }
+
+#------------------------------
+
+#line 503
+
+sub use_RS {
+    my ($self, $yesno) = @_;
+    carp "use_RS is deprecated and ignored; \$/ is always consulted\n";
+ }
+
+#------------------------------
+
+#line 517
+
+sub setpos { shift->seek($_[0],0) }
+
+#------------------------------
+
+#line 528
+
+*getpos = \&tell;
+
+
+#------------------------------
+
+#line 540
+
+sub sref { *{shift()}->{SR} }
+
+
+#------------------------------
+# Tied handle methods...
+#------------------------------
+
+# Conventional tiehandle interface:
+sub TIEHANDLE {
+    ((defined($_[1]) && UNIVERSAL::isa($_[1], __PACKAGE__))
+     ? $_[1]
+     : shift->new(@_));
+}
+sub GETC      { shift->getc(@_) }
+sub PRINT     { shift->print(@_) }
+sub PRINTF    { shift->print(sprintf(shift, @_)) }
+sub READ      { shift->read(@_) }
+sub READLINE  { wantarray ? shift->getlines(@_) : shift->getline(@_) }
+sub WRITE     { shift->write(@_); }
+sub CLOSE     { shift->close(@_); }
+sub SEEK      { shift->seek(@_); }
+sub TELL      { shift->tell(@_); }
+sub EOF       { shift->eof(@_); }
+
+#------------------------------------------------------------
+
+1;
+
+__END__
+
+
+
+#line 576
+
+
+#line 657
+

Modified: branches/upstream/libpar-packer-perl/current/lib/PAR/Packer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/lib/PAR/Packer.pm?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/lib/PAR/Packer.pm (original)
+++ branches/upstream/libpar-packer-perl/current/lib/PAR/Packer.pm Fri Dec 24 23:03:26 2010
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = '1.006';
+our $VERSION = '1.008';
 
 =head1 NAME
 
@@ -1684,17 +1684,22 @@
     my $clean_inc = '';
     if ($opt->{B}) { # bundle core modules
         # weed out all @INC entries
+        # use a canonicalized $ENV{PAR_TEMP}: this path was created by C code
+        # and may not be in canonical form (so that the match below will
+        # fail); case inpoint: some versions of FreeBSD have
+        #  #define P_tmpdir "/var/tmp/"
+        # in /usr/include/stdio.h (note the trailing slash)
         $clean_inc = <<'__CLEAN_INC__';
 # Remove everything but PAR hooks from @INC
 my %keep = (
     \&PAR::find_par => 1,
     \&PAR::find_par_last => 1,
 );
-my $par_temp_dir = quotemeta( $ENV{PAR_TEMP} );
+my $par_temp_dir = File::Spec->catdir( $ENV{PAR_TEMP} );
 @INC =
     grep {
         exists($keep{$_})
-        or $_ =~ /^$par_temp_dir/;
+        or $_ =~ /^\Q$par_temp_dir\E/;
     }
     @INC;
 __CLEAN_INC__

Modified: branches/upstream/libpar-packer-perl/current/lib/pp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/lib/pp.pm?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/lib/pp.pm (original)
+++ branches/upstream/libpar-packer-perl/current/lib/pp.pm Fri Dec 24 23:03:26 2010
@@ -28,6 +28,8 @@
     help() if $opt{h};
     version() if $opt{V};
     
+    local $Module::ScanDeps::ScanFileRE = qr/./;
+
     App::Packer::PAR->new(
         frontend    => 'Module::ScanDeps',
         backend     => 'PAR::Packer',

Modified: branches/upstream/libpar-packer-perl/current/myldr/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/myldr/Makefile.PL?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/myldr/Makefile.PL (original)
+++ branches/upstream/libpar-packer-perl/current/myldr/Makefile.PL Fri Dec 24 23:03:26 2010
@@ -95,7 +95,7 @@
     $lddebug = $debug ? '-debug ' : '-release ';
     $warn = $debug ? '-W3' : '';
     $res = $Config{ivsize} == 4 ? 'win32.obj' : '';
-    $long_literal = 0;
+    $long_literal = '';
     # Embed the manifest file for VC 2005 (aka VC8) or higher, but not for the
     # 64-bit Platform SDK compiler
     if( $Config{ivsize} == 4 and $Config{ccversion} =~ /^(\d+)/ and $1 >= 14 ) {
@@ -103,13 +103,13 @@
     } else {
         $mt_cmd = '-$(NOOP)';
     }
-} elsif ($cc =~ m/^gcc\b/i or ($cc =~ m/^cc\b/i and $gccversion)) {
+} elsif ($cc =~ m/\bgcc\b/i or ($cc =~ m/\bcc\b/i and $gccversion)) {
     $out = '-o ';
     $ccdebug = $debug ? '-g ' : '';
     $lddebug = ($debug or $^O eq 'darwin') ? '' : '-s ';
     $warn = $debug ? '-Wall -Wno-comments ' : '';
     $res = ($^O =~ /^(?:MSWin|cygwin)/) ? 'win32.coff' : '';
-    $long_literal = 1;
+    $long_literal = '-l';
     $mt_cmd = '-$(NOOP)';
 } else {
     $out = '-o ';
@@ -117,7 +117,7 @@
     $lddebug = '';
     $warn = '';
     $res = '';
-    $long_literal = 0; # better safe than sorry
+    $long_literal = ''; # better safe than sorry
     $mt_cmd = '-$(NOOP)';
 }
 
@@ -159,7 +159,36 @@
     undef $dynperl if !-e $libperl;
 }
 
-if (not $dynperl) {
+# In the $dynperl case, we've already found the $libperl DSO.
+# The only problem is: when the linker links $par_exe against $libperl
+# we don't know what name is used to refer to $libperl in the executable
+# (e.g. on an ELF based system the DT_NEEDED tag). This is the name
+# the dynamic loader is looking for when $par_exe is executed.
+#
+# So we better make sure that $libperl is extracted using this name
+# during bootstrap of a packed executable. If we use the wrong name for
+# extraction, $libperl won't be considered by the dynamic loader.
+# This may cause the bootstrap to fail. Or the dynamic loader 
+# might find a libperl DSO (e.g in /usr/lib using the built-in library
+# search path) from a Perl installation with the expected name.
+# However, this libperl may be ABI incompatible with $par_exe,
+# leading to hard to diagnose errors.
+#
+# Below we make a feeble attempt to determine this "link name" for some
+# well-known platforms. The fallback is always the basename of $libperl.
+# For ELF based systems the linker uses the DSO's DT_SONAME tag
+# as the link name if present. If the system uses the GNU binutils
+# toolchain we can use the objdump tool to find the DSO's soname.
+
+my $extract_libperl_as;
+if ($dynperl) {
+    $extract_libperl_as = basename($libperl);
+    if ($^O =~ /linux/i) 
+    {
+        my ($soname) = qx(objdump -ax $libperl) =~ /^\s*SONAME\s+(\S+)/m;
+        $extract_libperl_as = $soname if $? == 0 && defined $soname;
+    }
+} else {
     my $file = $Config{libperl};
     $file = 'libperl.a' if $file eq 'libper'; # same redhat bug? Just making sure...
     $libperl = find_file($file);
@@ -276,7 +305,7 @@
 	$mt_cmd
 
 my_par_pl.c: $par_pl
-	\$(PERL) $f2c $par_pl \$@ load_my_par_pl $long_literal
+	\$(PERL) $f2c -s $par_pl $long_literal \$@ load_my_par_pl
 
 $parl_exe: $par
 	\$(PERL) run_with_inc.pl $par -I../blib/lib -q -B -O\$@
@@ -315,13 +344,13 @@
 	\$(PERL) parlsig.pl $static_exe $par_exe $dynperl $chunk_size
 
 my_par.c: $par_exe
-	\$(PERL) $f2c $par_exe \$@ load_my_par $long_literal $chunk_size
+	\$(PERL) $f2c $long_literal -c $chunk_size $par_exe \$@ load_my_par
 
 my_libperl.c:
-	\$(PERL) $f2c $libperl \$@ load_my_libperl $long_literal $chunk_size
+	\$(PERL) $f2c $long_literal -c $chunk_size -n $extract_libperl_as $libperl \$@ load_my_libperl
 
 my_libgcc.c:
-	\$(PERL) $f2c $libgcc \$@ load_my_libgcc $long_literal $chunk_size
+	\$(PERL) $f2c $long_literal -c $chunk_size $libgcc \$@ load_my_libgcc
 
 strippedparldyn: $par_exe
 	\$(PERL) -e "chmod(oct('0600'), '$strippedparldyn_mod');"

Modified: branches/upstream/libpar-packer-perl/current/myldr/file2c.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/myldr/file2c.pl?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/myldr/file2c.pl (original)
+++ branches/upstream/libpar-packer-perl/current/myldr/file2c.pl Fri Dec 24 23:03:26 2010
@@ -9,85 +9,80 @@
 use FindBin;
 use lib "$FindBin::Bin/../lib";
 use File::Basename;
+use Getopt::Long;
 use PAR::Filter::PodStrip;
 
-my $give_help = 0;
-my $pl_file = shift;
-my $c_file = shift;
-my $c_var = shift;
-my $long_literal = shift;
-my $chunk_size = shift;
+my $chunk_size = 0;
+my $long_literal;
+my $strip_pod;
+my $name;
 
-$give_help ||= ( !defined $pl_file or
-                !defined $c_file or
-                !defined $c_var );
-$pl_file ||= '';
-$c_file ||= '';
-$give_help ||= !-e $pl_file;
-if( $give_help ) {
-  print <<EOT;
-Usage: $0 file.pl file.c c_variable
-EOT
+GetOptions(
+    "c|chunk-size=i"    => \$chunk_size,
+    "l|long-literal"    => \$long_literal,
+    "s|strip_pod"       => \$strip_pod,
+    "n|name=s"          => \$name,
+) && @ARGV == 3
+    or die "Usage: $0 [-c chunk_size][-l][-n name][-s] file.pl file.c c_variable\n";
+my ($pl_file, $c_file, $c_var) = @ARGV;
+$name = basename($pl_file) unless defined $name;
 
-  exit 1;
-}
+my $pl_text = do        # NOTE: scalar ref
+{
+    open my $in, "<", $pl_file or die "open input file '$pl_file': $!";
+    binmode $in;
+    local $/ = undef;
+    my $slurp = <$in>;
+    close $in;
+    \$slurp;
+};
 
-open IN, "< $pl_file" or die "open '$pl_file': $!";
-open OUT, "> $c_file" or die "open '$c_file': $!";
-binmode IN; binmode OUT;
+PAR::Filter::PodStrip->new->apply($pl_text) if $strip_pod;
 
-# read perl file
-undef $/;
-my $pl_text = <IN>;
-close IN;
-
-PAR::Filter::PodStrip->new->apply(\$pl_text)
-    if -e $pl_file and $pl_file =~ /\.p[lm]/i;
+open my $out, ">", $c_file or die "open output file '$c_file': $!";
+binmode $out;
 
 #  make a c-array
 
-print OUT "const char * name_$c_var = \"" . basename($pl_file) . "\";\n";
+print $out "const char * name_$c_var = \"$name\";\n";
 
-if (!$chunk_size) {
-    print_chunk($pl_text, '');
-    print OUT "#define WRITE_$c_var(i) write(i, $c_var, (size_t)size_$c_var);\n";
+if ($chunk_size) {
+    my $len = length $$pl_text;
+    my $chunk_count = int(( $len + $chunk_size - 1 ) / $chunk_size);
+    print $out "unsigned long size_$c_var = $len;\n";
+
+    for (my $i = 0; $i < $chunk_count; $i++) {
+	print_chunk( substr($$pl_text, $i * $chunk_size, $chunk_size), "_$i" );
+    }
+
+    print $out "#define WRITE_$c_var(i)";
+    for (my $i = 0; $i < $chunk_count; $i++) {
+	print $out " write(i, ${c_var}_$i, (size_t)size_${c_var}_$i);";
+    }
+    print $out "\n";
 }
 else {
-    my $chunk_count = int(length($pl_text) / $chunk_size) + 1;
-    print OUT "unsigned long size_$c_var = " . length($pl_text) . ";\n";
+    print_chunk( $$pl_text, '' );
+    print $out "#define WRITE_${c_var}(i) write(i, $c_var, (size_t)size_${c_var});\n";
+}
+close $out;
 
-    for (1 .. $chunk_count) {
-	print_chunk( substr($pl_text, ($_ - 1) * $chunk_size, $chunk_size), "_$_" );
+sub print_chunk {
+    my $chunk = reverse($_[0]);
+    my $suffix = $_[1];
+
+    my $len = length $chunk;
+    print $out "unsigned long size_${c_var}${suffix} = $len;\n";
+    print $out "const char ${c_var}${suffix}[] = ";
+    print $out $long_literal ? "\"" : "{";
+
+    my $fmt = $long_literal ? "\\x%02x" : "0x%02x,";
+    while ($len--) {
+        printf $out $fmt, ord(chop($chunk));
+        print $out $long_literal ? "\"\n\"" :"\n" unless $len % 16;
     }
 
-    print OUT "#define WRITE_$c_var(i)";
-    for (1 .. $chunk_count) {
-	print OUT " write(i, ${c_var}_$_, (size_t)size_${c_var}_$_);";
-    }
-    print OUT "\n";
-}
-close OUT;
-
-sub print_chunk {
-    my $text = reverse($_[0]);
-    my $suffix = $_[1];
-
-    print OUT "unsigned long size_$c_var$suffix = " . length($text) . ";\n";
-    print OUT "const char $c_var$suffix\[" . (length($text) + 1) . "] = ";
-    print OUT $long_literal ? '"' : '{';
-
-    my $i;
-    for (1 .. length($text)) {
-	if ($long_literal) {
-	    print OUT sprintf '\%03o', ord(chop($text));
-	}
-	else {
-	    print OUT sprintf "'\\%03o',", ord(chop($text));
-	    print OUT "\n" unless $i++ % 16;
-	}
-    }
-
-    print OUT $long_literal ? "\";\n" : "0\n};\n";
+    print $out $long_literal ? "\";\n" : "\n};\n";
 }
 
 # local variables:

Modified: branches/upstream/libpar-packer-perl/current/myldr/main.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/myldr/main.c?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/myldr/main.c (original)
+++ branches/upstream/libpar-packer-perl/current/myldr/main.c Fri Dec 24 23:03:26 2010
@@ -57,6 +57,7 @@
 {
     int exitstatus;
     int i;
+    int argno = 0;
 
 #ifdef PERL_GPROF_MONCONTROL
     PERL_GPROF_MONCONTROL(0);
@@ -112,7 +113,6 @@
 #endif /* ALLOW_PERL_OPTIONS */
     New(666, fakeargv, argc + EXTRA_OPTIONS + 1 + PROFILING_OPTION, char *);
 
-    int argno = 0;
     fakeargv[argno++] = argv[0];
 #ifdef PERL_PROFILING
     fakeargv[argno++] = "-d:DProf";

Modified: branches/upstream/libpar-packer-perl/current/myldr/mktmpdir.h
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/myldr/mktmpdir.h?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/myldr/mktmpdir.h (original)
+++ branches/upstream/libpar-packer-perl/current/myldr/mktmpdir.h Fri Dec 24 23:03:26 2010
@@ -1,3 +1,12 @@
+#ifdef _MSC_VER
+#  define snprintf _snprintf
+#  if _MSC_VER < 1500
+#    define vsnprintf _vsnprintf
+#  endif
+#  define strncasecmp _strnicmp
+#  define strcasecmp _stricmp
+#endif
+
 #include <ctype.h>
 #include <errno.h>
 #include <fcntl.h>

Modified: branches/upstream/libpar-packer-perl/current/myldr/static.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/myldr/static.c?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/myldr/static.c (original)
+++ branches/upstream/libpar-packer-perl/current/myldr/static.c Fri Dec 24 23:03:26 2010
@@ -18,7 +18,7 @@
          && (unsigned long)statbuf.st_size == expected_size )
 	return -2;
 
-    i = open(*file_p, O_CREAT | O_WRONLY | OPEN_O_BINARY, 0777);
+    i = open(*file_p, O_CREAT | O_WRONLY | OPEN_O_BINARY, 0755);
 
     if (i == -1) {
         fprintf(stderr, "%s: creation of %s failed - aborting with errno %i.\n", argv0, *file_p, errno);
@@ -27,6 +27,12 @@
 
     return i;
 }
+
+
+/* turn off automatic globbing of process arguments when using MingW */
+#if defined(WIN32) && defined(__MINGW32__)
+int _CRT_glob = 0;
+#endif
 
 int main ( int argc, char **argv, char **env )
 {

Modified: branches/upstream/libpar-packer-perl/current/t/30-current_exec.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/t/30-current_exec.t?rev=66256&op=diff
==============================================================================
--- branches/upstream/libpar-packer-perl/current/t/30-current_exec.t (original)
+++ branches/upstream/libpar-packer-perl/current/t/30-current_exec.t Fri Dec 24 23:03:26 2010
@@ -16,7 +16,7 @@
 # warn $@ if $@;
 
 ####
-my $EXEC = File::Spec->catfile( $FindBin::Bin, "test-10.exec" );
+my $EXEC = File::Spec->catfile( $FindBin::Bin, "test-10$Config{_exe}" );
 my $TEMP = join '-', $FindBin::Bin, "tmp";
 my $SCRIPT = File::Spec->catdir( $FindBin::Bin, File::Spec->updir, "blib", "script" );
 my $PP = File::Spec->catfile( $SCRIPT, 'pp' );
@@ -50,7 +50,7 @@
 
 my( $file, $path ) = fileparse( $EXEC );
 
-my $out_path = do { local $ENV{PATH} = $path; qx($file); };
+my $out_path = do { local $ENV{PATH} = join($sep, $path, File::Spec->path()); qx($file); };
 
 is( $out_path, $out_full, "Found the same file via PATH and full path" );
 

Added: branches/upstream/libpar-packer-perl/current/t/90-rt59710.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpar-packer-perl/current/t/90-rt59710.t?rev=66256&op=file
==============================================================================
--- branches/upstream/libpar-packer-perl/current/t/90-rt59710.t (added)
+++ branches/upstream/libpar-packer-perl/current/t/90-rt59710.t Fri Dec 24 23:03:26 2010
@@ -1,0 +1,29 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Config;
+use File::Spec;
+use FindBin;
+
+use Test::More;
+plan skip_all => "Unicode::UCD appeared first in perl 5.8.0"
+    unless $] >= 5.008;
+plan tests => 3; # FIXME
+
+my $EXE = File::Spec->catfile( File::Spec->tmpdir,"rt59710$Config{_exe}");
+my $PP = File::Spec->catdir( $FindBin::Bin, File::Spec->updir, qw( blib script pp ));
+
+unlink $EXE;
+
+system $PP, 
+    -o => $EXE, 
+    -e => 'use Unicode::UCD qw(charinfo); my $i = charinfo(0x42); print $i->{name};';
+ok( $? == 0 && -f $EXE, "Created \"$EXE\"" ) 
+        or die "Failed to create \"$EXE\"!\n";
+
+my $name = qx( $EXE );
+ok( $? == 0, "\"$EXE\" ran successfully");
+is( $name, "LATIN CAPITAL LETTER B" );
+
+# cleanup
+unlink $EXE;




More information about the Pkg-perl-cvs-commits mailing list