develooper Front page | perl.perl5.changes | Postings from May 2008

Change 33933: Integrate:

From:
Nicholas Clark
Date:
May 25, 2008 16:15
Subject:
Change 33933: Integrate:
Change 33933 by nicholas@mouse-mill on 2008/05/25 23:13:54

	Integrate:
	[ 33878]
	Integrate:
	[ 33740]
	Stop File::Copy truncating destination files if passed 3 named
	arguments by accident. In Copy.t, ensure that all file system calls
	die with $! if they fail.
	
	[ 33793]
	Subject: [PATCH lib/File/Copy.pm]  Use 3-arg open.
	From: Abigail <abigail@abigail.be>
	Date: Tue, 6 May 2008 17:38:28 +0200
	Message-ID: <20080506153828.GA27662@abigail.be>
	
	[ 33881]
	Integrate:
	[ 33825]
	It transpires that POSIX.xs also duplicated several constants defined
	by Fcntl but only conditionally exported by Fcntl. The most obvious
	were SEEK_CUR, SEEK_END and SEEK_SET, as reported in bug #54186.
	So add them to the list of constants that POSIX imports from Fcntl.
	
	[ 33826]
	Remove POSIX's internal implementation of S_ISBLK, S_ISCHR, S_ISDIR,
	S_ISFIFO and S_ISREG, and pull them in from Fcntl. Spotted as a result
	of bug #54186, but there has been a redefined subroutine warning for
	ages if you elected to import all of POSIX and Fcntl's exports.
	
	[ 33829]
	Fix my typo.
	
	[ 33885]
	Integrate:
	[ 33835]
	Subject: [PATCH] h2ph: allow the quote mark delimiter when chasing #include directives with "-a"
	From: Niko Tyni <ntyni@debian.org>
	Date: Thu, 15 May 2008 23:15:35 +0300
	Message-Id: <1210882535-11072-1-git-send-email-ntyni@debian.org>
	
	[ 33917]
	Integrate:
	[ 33911]
	Subject: [PATCH] Re: [perl #41555] Bug in File::Find on Windows when target
	From: Bram <p5p@perl.wizbit.be>
	Date: Mon, 12 May 2008 22:13:33 +0200
	Message-ID: <20080512221333.mq0283dlessws4wk@horde.wizbit.be>

Affected files ...

... //depot/maint-5.8/perl/ext/B/t/concise-xs.t#21 integrate
... //depot/maint-5.8/perl/ext/POSIX/Makefile.PL#9 integrate
... //depot/maint-5.8/perl/ext/POSIX/POSIX.pm#17 integrate
... //depot/maint-5.8/perl/ext/POSIX/POSIX.xs#39 integrate
... //depot/maint-5.8/perl/lib/File/Copy.pm#18 integrate
... //depot/maint-5.8/perl/lib/File/Copy.t#8 integrate
... //depot/maint-5.8/perl/lib/File/Find.pm#21 integrate
... //depot/maint-5.8/perl/lib/File/Find/t/find.t#8 integrate
... //depot/maint-5.8/perl/t/lib/proxy_constant_subs.t#2 integrate
... //depot/maint-5.8/perl/utils/h2ph.PL#14 integrate

Differences ...

==== //depot/maint-5.8/perl/ext/B/t/concise-xs.t#21 (text) ====
Index: perl/ext/B/t/concise-xs.t
--- perl/ext/B/t/concise-xs.t#20~32265~	2007-11-10 03:31:16.000000000 -0800
+++ perl/ext/B/t/concise-xs.t	2008-05-25 16:13:54.000000000 -0700
@@ -177,7 +177,10 @@
 		 },
 
     POSIX => { dflt => 'noSTART', # in maint, they're autoloaded and perl.
-	       skip => [qw/ _POSIX_JOB_CONTROL /],	# platform varying
+	       skip => [qw/ _POSIX_JOB_CONTROL /,	# platform varying
+			# Might be XS or imported from Fcntl, depending on your
+			# perl version:
+			qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /],
 	       perl => [qw/ import croak AUTOLOAD /],
 
 	       XS => [qw/ write wctomb wcstombs uname tzset tzname

==== //depot/maint-5.8/perl/ext/POSIX/Makefile.PL#9 (text) ====
Index: perl/ext/POSIX/Makefile.PL
--- perl/ext/POSIX/Makefile.PL#8~32570~	2007-12-04 06:19:41.000000000 -0800
+++ perl/ext/POSIX/Makefile.PL	2008-05-25 16:13:54.000000000 -0700
@@ -48,13 +48,11 @@
       MAX_INPUT MB_LEN_MAX MSG_CTRUNC MSG_DONTROUTE MSG_EOR MSG_OOB MSG_PEEK 
       MSG_TRUNC MSG_WAITALL NAME_MAX NCCS NGROUPS_MAX NOFLSH OPEN_MAX OPOST
       PARENB PARMRK PARODD PATH_MAX PIPE_BUF RAND_MAX R_OK SCHAR_MAX
-      SCHAR_MIN SEEK_CUR SEEK_END SEEK_SET SHRT_MAX SHRT_MIN SIGABRT SIGALRM
+      SCHAR_MIN SHRT_MAX SHRT_MIN SIGABRT SIGALRM
       SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT
       SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
       SIGUSR1 SIGUSR2 SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SSIZE_MAX
-      STDERR_FILENO STDIN_FILENO STDOUT_FILENO STREAM_MAX
-      S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
-      S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR TCIFLUSH TCIOFF
+      STDERR_FILENO STDIN_FILENO STDOUT_FILENO STREAM_MAX TCIFLUSH TCIOFF
       TCIOFLUSH TCION TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
       TMP_MAX TOSTOP TZNAME_MAX VEOF VEOL VERASE VINTR VKILL VMIN VQUIT
       VSTART VSTOP VSUSP VTIME WNOHANG WUNTRACED W_OK X_OK

==== //depot/maint-5.8/perl/ext/POSIX/POSIX.pm#17 (text) ====
Index: perl/ext/POSIX/POSIX.pm
--- perl/ext/POSIX/POSIX.pm#16~33925~	2008-05-25 13:50:26.000000000 -0700
+++ perl/ext/POSIX/POSIX.pm	2008-05-25 16:13:54.000000000 -0700
@@ -6,7 +6,7 @@
 
 # Note that 5.8.x isn't carrying change 30590 from 5.10, so there might need to
 # be a version number dance to reflect this.
-our $VERSION = "1.14";
+our $VERSION = "1.15";
 
 use AutoLoader;
 
@@ -15,7 +15,10 @@
 use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
 	     F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
 	     O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
-	     O_WRONLY);
+	     O_WRONLY SEEK_CUR SEEK_END SEEK_SET
+	     S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
+	     S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
+	     S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
 
 # Grandfather old foo_h form to new :foo_h form
 my $loaded;
@@ -34,9 +37,9 @@
 
 XSLoader::load 'POSIX', $VERSION;
 
-my %NON_CONSTS = (map {($_,1)}
-                  qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS
-                     WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
+my %NON_CONSTS
+  = (map {($_,1)} qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG
+		     WTERMSIG));
 
 sub AUTOLOAD {
     no strict;

==== //depot/maint-5.8/perl/ext/POSIX/POSIX.xs#39 (text) ====
Index: perl/ext/POSIX/POSIX.xs
--- perl/ext/POSIX/POSIX.xs#38~33202~	2008-02-02 09:56:35.000000000 -0800
+++ perl/ext/POSIX/POSIX.xs	2008-05-25 16:13:54.000000000 -0700
@@ -404,7 +404,7 @@
 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
 
 my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
+my @names = (qw(WEXITSTATUS WIFEXITED
 	       WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
 
 print constant_types(); # macro defs
@@ -416,65 +416,14 @@
    */
 
   switch (len) {
-  case 7:
-    /* Names all of length 7.  */
-    /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
-    /* Offset 5 gives the best switch position.  */
-    switch (name[5]) {
-    case 'E':
-      if (memEQ(name, "S_ISREG", 7)) {
-      /*                    ^       */
-#ifdef S_ISREG
-        *arg_result = S_ISREG(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'H':
-      if (memEQ(name, "S_ISCHR", 7)) {
-      /*                    ^       */
-#ifdef S_ISCHR
-        *arg_result = S_ISCHR(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'I':
-      if (memEQ(name, "S_ISDIR", 7)) {
-      /*                    ^       */
-#ifdef S_ISDIR
-        *arg_result = S_ISDIR(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'L':
-      if (memEQ(name, "S_ISBLK", 7)) {
-      /*                    ^       */
-#ifdef S_ISBLK
-        *arg_result = S_ISBLK(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    }
-    break;
   case 8:
     /* Names all of length 8.  */
-    /* S_ISFIFO WSTOPSIG WTERMSIG */
-    /* Offset 3 gives the best switch position.  */
-    switch (name[3]) {
-    case 'O':
+    /* WSTOPSIG WTERMSIG */
+    /* Offset 1 gives the best switch position.  */
+    switch (name[1]) {
+    case 'S':
       if (memEQ(name, "WSTOPSIG", 8)) {
-      /*                  ^          */
+      /*                ^            */
 #ifdef WSTOPSIG
         int i = *arg_result;
         *arg_result = WSTOPSIG(WMUNGE(i));
@@ -484,9 +433,9 @@
 #endif
       }
       break;
-    case 'R':
+    case 'T':
       if (memEQ(name, "WTERMSIG", 8)) {
-      /*                  ^          */
+      /*                ^            */
 #ifdef WTERMSIG
         int i = *arg_result;
         *arg_result = WTERMSIG(WMUNGE(i));
@@ -496,17 +445,6 @@
 #endif
       }
       break;
-    case 'S':
-      if (memEQ(name, "S_ISFIFO", 8)) {
-      /*                  ^          */
-#ifdef S_ISFIFO
-        *arg_result = S_ISFIFO(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
     }
     break;
   case 9:

==== //depot/maint-5.8/perl/lib/File/Copy.pm#18 (text) ====
Index: perl/lib/File/Copy.pm
--- perl/lib/File/Copy.pm#17~32455~	2007-11-22 14:07:11.000000000 -0800
+++ perl/lib/File/Copy.pm	2008-05-25 16:13:54.000000000 -0700
@@ -24,7 +24,7 @@
 # package has not yet been updated to work with Perl 5.004, and so it
 # would be a Bad Thing for the CPAN module to grab it and replace this
 # module.  Therefore, we set this module's version higher than 2.0.
-$VERSION = '2.11';
+$VERSION = '2.12';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -70,6 +70,12 @@
     my $from = shift;
     my $to = shift;
 
+    my $size;
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
+    }
+
     my $from_a_handle = (ref($from)
 			 ? (ref($from) eq 'GLOB'
 			    || UNIVERSAL::isa($from, 'GLOB')
@@ -139,7 +145,7 @@
 
     my $closefrom = 0;
     my $closeto = 0;
-    my ($size, $status, $r, $buf);
+    my ($status, $r, $buf);
     local($\) = '';
 
     my $from_h;
@@ -148,31 +154,30 @@
     } else {
 	$from = _protect($from) if $from =~ /^\s/s;
        $from_h = \do { local *FH };
-       open($from_h, "< $from\0") or goto fail_open1;
+       open $from_h, "<", $from or goto fail_open1;
        binmode $from_h or die "($!,$^E)";
 	$closefrom = 1;
     }
 
+    # Seems most logical to do this here, in case future changes would want to
+    # make this croak for some reason.
+    unless (defined $size) {
+	$size = tied(*$from_h) ? 0 : -s $from_h || 0;
+	$size = 1024 if ($size < 512);
+	$size = $Too_Big if ($size > $Too_Big);
+    }
+
     my $to_h;
     if ($to_a_handle) {
        $to_h = $to;
     } else {
 	$to = _protect($to) if $to =~ /^\s/s;
        $to_h = \do { local *FH };
-       open($to_h,"> $to\0") or goto fail_open2;
+       open $to_h, ">", $to or goto fail_open2;
        binmode $to_h or die "($!,$^E)";
 	$closeto = 1;
     }
 
-    if (@_) {
-	$size = shift(@_) + 0;
-	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
-    } else {
-	$size = tied(*$from_h) ? 0 : -s $from_h || 0;
-	$size = 1024 if ($size < 512);
-	$size = $Too_Big if ($size > $Too_Big);
-    }
-
     $! = 0;
     for (;;) {
 	my ($r, $w, $t);

==== //depot/maint-5.8/perl/lib/File/Copy.t#8 (xtext) ====
Index: perl/lib/File/Copy.t
--- perl/lib/File/Copy.t#7~30174~	2007-02-08 08:02:24.000000000 -0800
+++ perl/lib/File/Copy.t	2008-05-25 16:13:54.000000000 -0700
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
    if( $ENV{PERL_CORE} ) {
@@ -11,7 +11,7 @@
 
 my $TB = Test::More->builder;
 
-plan tests => 60;
+plan tests => 70;
 
 # We're going to override rename() later on but Perl has to see an override
 # at compile time to honor it.
@@ -40,14 +40,14 @@
   }
 
   # First we create a file
-  open(F, ">file-$$") or die;
+  open(F, ">file-$$") or die $!;
   binmode F; # for DOSISH platforms, because test 3 copies to stdout
   printf F "ok\n";
   close F;
 
   copy "file-$$", "copy-$$";
 
-  open(F, "copy-$$") or die;
+  open(F, "copy-$$") or die $!;
   $foo = <F>;
   close(F);
 
@@ -77,7 +77,7 @@
 
   require IO::File;
   $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
-  binmode $fh or die;
+  binmode $fh or die $!;
   copy("file-$$",$fh);
   $fh->close or die "close: $!";
   open(R, "copy-$$") or die; $foo = <R>; close(R);
@@ -86,10 +86,10 @@
 
   require FileHandle;
   my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
-  binmode $fh or die;
+  binmode $fh or die $!;
   copy("file-$$",$fh);
   $fh->close;
-  open(R, "copy-$$") or die; $foo = <R>; close(R);
+  open(R, "copy-$$") or die $!; $foo = <R>; close(R);
   is $foo, "ok\n", 'copy(fn, fh): same contents';
   unlink "file-$$" or die "unlink: $!";
 
@@ -108,7 +108,7 @@
   ok move("copy-$$", "file-$$"), 'move';
   ok -e "file-$$",              '  destination exists';
   ok !-e "copy-$$",              '  source does not';
-  open(R, "file-$$") or die; $foo = <R>; close(R);
+  open(R, "file-$$") or die $!; $foo = <R>; close(R);
   is $foo, "ok\n", 'contents preserved';
 
   TODO: {
@@ -121,7 +121,7 @@
   }
 
   # trick: create lib/ if not exists - not needed in Perl core
-  unless (-d 'lib') { mkdir 'lib' or die; }
+  unless (-d 'lib') { mkdir 'lib' or die $!; }
   copy "file-$$", "lib";
   open(R, "lib/file-$$") or die $!; $foo = <R>; close(R);
   is $foo, "ok\n", 'copy(fn, dir): same contents';
@@ -129,7 +129,7 @@
 
   # Do it twice to ensure copying over the same file works.
   copy "file-$$", "lib";
-  open(R, "lib/file-$$") or die; $foo = <R>; close(R);
+  open(R, "lib/file-$$") or die $!; $foo = <R>; close(R);
   is $foo, "ok\n", 'copy over the same file works';
   unlink "lib/file-$$" or die "unlink: $!";
 
@@ -164,8 +164,8 @@
     ok !-z "file-$$", 
       'rt.perl.org 5196: copying to itself would truncate the file';
 
-    unlink "symlink-$$";
-    unlink "file-$$";
+    unlink "symlink-$$" or die $!;
+    unlink "file-$$" or die $!;
   }
 
   SKIP: {
@@ -185,9 +185,41 @@
     ok ! -z "file-$$",
       'rt.perl.org 5196: copying to itself would truncate the file';
 
-    unlink "hardlink-$$";
-    unlink "file-$$";
+    unlink "hardlink-$$" or die $!;
+    unlink "file-$$" or die $!;
   }
+
+  open(F, ">file-$$") or die $!;
+  binmode F;
+  print F "this is file\n";
+  close F;
+
+  my $copy_msg = "this is copy\n";
+  open(F, ">copy-$$") or die $!;
+  binmode F;
+  print F $copy_msg;
+  close F;
+
+  my @warnings;
+  local $SIG{__WARN__} = sub { push @warnings, join '', @_ };
+
+  # pie-$$ so that we force a non-constant, else the numeric conversion (of 0)
+  # is cached and we don't get a warning the second time round
+  is eval { copy("file-$$", "copy-$$", "pie-$$"); 1 }, undef,
+    "a bad buffer size fails to copy";
+  like $@, qr/Bad buffer size for copy/, "with a helpful error message";
+  unless (is scalar @warnings, 1, "There is 1 warning") {
+    diag $_ foreach @warnings;
+  }
+
+  is -s "copy-$$", length $copy_msg, "but does not truncate the destination";
+  open(F, "copy-$$") or die $!;
+  $foo = <F>;
+  close(F);
+  is $foo, $copy_msg, "nor change the destination's contents";
+
+  unlink "file-$$" or die $!;
+  unlink "copy-$$" or die $!;
 }
 
 

==== //depot/maint-5.8/perl/lib/File/Find.pm#21 (text) ====
Index: perl/lib/File/Find.pm
--- perl/lib/File/Find.pm#20~33925~	2008-05-25 13:50:26.000000000 -0700
+++ perl/lib/File/Find.pm	2008-05-25 16:13:54.000000000 -0700
@@ -779,7 +779,7 @@
     if ($Is_MacOS) {
 	$dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
     } elsif ($^O eq 'MSWin32') {
-	$dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
+	$dir_pref = ($p_dir =~ m|\w:/?$| ? $p_dir : "$p_dir/" );
     } elsif ($^O eq 'VMS') {
 	$dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
     }
@@ -955,7 +955,7 @@
 		$dir_pref = "$dir_name:";
 	    }
 	    elsif ($^O eq 'MSWin32') {
-		$dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
+		$dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
 		$dir_pref = "$dir_name/";
 	    }
 	    elsif ($^O eq 'VMS') {

==== //depot/maint-5.8/perl/lib/File/Find/t/find.t#8 (text) ====
Index: perl/lib/File/Find/t/find.t
--- perl/lib/File/Find/t/find.t#7~32455~	2007-11-22 14:07:11.000000000 -0800
+++ perl/lib/File/Find/t/find.t	2008-05-25 16:13:54.000000000 -0700
@@ -18,8 +18,14 @@
     $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }
 }
 
-if ( $symlink_exists ) { print "1..199\n"; }
-else                   { print "1..85\n";  }
+my $test_count = 85;
+$test_count += 114 if $symlink_exists;
+$test_count += 18 if $^O eq 'MSWin32';
+$test_count += 2 if $^O eq 'MSWin32' and $symlink_exists;
+
+print "1..$test_count\n";
+#if ( $symlink_exists ) { print "1..199\n"; }
+#else                   { print "1..85\n";  }
 
 my $orig_dir = cwd();
 
@@ -829,3 +835,60 @@
     unlink file_path('fa', 'faa_sl');
 
 }
+
+
+# Win32 checks  - [perl #41555]
+if ($^O eq 'MSWin32') {
+    require File::Spec::Win32;
+    my ($volume) = File::Spec::Win32->splitpath($orig_dir, 1);
+    print STDERR "VOLUME = $volume\n";
+    
+    # with chdir
+    %Expect_File = (File::Spec->curdir => 1,
+                    file_path('fsl') => 1,
+                    file_path('fa_ord') => 1,
+                    file_path('fab') => 1,
+                    file_path('fab_ord') => 1,
+                    file_path('faba') => 1,
+                    file_path('faba_ord') => 1,
+                    file_path('faa') => 1,
+                    file_path('faa_ord') => 1);
+
+    delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+                   dir_path('faa') => 1,
+                   dir_path('fab') => 1,
+                   dir_path('faba') => 1,
+                   dir_path('fb') => 1,
+                   dir_path('fba') => 1);
+    
+    
+    
+    File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa'));
+    Check( scalar(keys %Expect_File) == 0 );    
+    
+    # no_chdir
+    %Expect_File = ($volume . file_path_name('fa') => 1,
+                    $volume . file_path_name('fa', 'fsl') => 1,
+                    $volume . file_path_name('fa', 'fa_ord') => 1,
+                    $volume . file_path_name('fa', 'fab') => 1,
+                    $volume . file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    $volume . file_path_name('fa', 'fab', 'faba') => 1,
+                    $volume . file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    $volume . file_path_name('fa', 'faa') => 1,
+                    $volume . file_path_name('fa', 'faa', 'faa_ord') => 1);
+                    
+
+    delete $Expect_File{ $volume . file_path_name('fa', 'fsl') } unless $symlink_exists;
+    %Expect_Name = ();
+
+    %Expect_Dir = ($volume . dir_path('fa') => 1,
+                   $volume . dir_path('fa', 'faa') => 1,
+                   $volume . dir_path('fa', 'fab') => 1,
+                   $volume . dir_path('fa', 'fab', 'faba') => 1);
+                   
+    File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, $volume . topdir('fa'));
+    Check( scalar(keys %Expect_File) == 0 );
+}

==== //depot/maint-5.8/perl/t/lib/proxy_constant_subs.t#2 (text) ====
Index: perl/t/lib/proxy_constant_subs.t
--- perl/t/lib/proxy_constant_subs.t#1~30302~	2007-02-14 14:00:02.000000000 -0800
+++ perl/t/lib/proxy_constant_subs.t	2008-05-25 16:13:54.000000000 -0700
@@ -7,20 +7,20 @@
         print "1..0 # Skip -- Perl configured without B module\n";
         exit 0;
     }
-    if ($Config::Config{'extensions'} !~ /\bPOSIX\b/) {
-        print "1..0 # Skip -- Perl configured without POSIX\n";
+    if ($Config::Config{'extensions'} !~ /\bFcntl\b/) {
+        print "1..0 # Skip -- Perl configured without Fcntl\n";
         exit 0;
     }
-    # errno is a real subroutine, and acts as control
+    # S_IFMT is a real subroutine, and acts as control
     # SEEK_SET is a proxy constant subroutine.
-    @symbols = qw(errno SEEK_SET);
+    @symbols = qw(S_IFMT SEEK_SET);
 }
 
 use strict;
 use warnings;
 use Test::More tests => 4 * @symbols;
 use B qw(svref_2object GVf_IMPORTED_CV);
-use POSIX @symbols;
+use Fcntl @symbols;
 
 # GVf_IMPORTED_CV should not be set on the original, but should be set on the
 # imported GV.
@@ -29,7 +29,7 @@
     my ($ps, $ms);
     {
 	no strict 'refs';
-	$ps = svref_2object(\*{"POSIX::$symbol"});
+	$ps = svref_2object(\*{"Fcntl::$symbol"});
 	$ms = svref_2object(\*{"::$symbol"});
     }
     isa_ok($ps, 'B::GV');

==== //depot/maint-5.8/perl/utils/h2ph.PL#14 (text) ====
Index: perl/utils/h2ph.PL
--- perl/utils/h2ph.PL#13~31035~	2007-04-23 07:40:27.000000000 -0700
+++ perl/utils/h2ph.PL	2008-05-25 16:13:54.000000000 -0700
@@ -85,7 +85,7 @@
 }
 
 my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
-my ($incl, $incl_type, $next);
+my ($incl, $incl_type, $incl_quote, $next);
 while (defined (my $file = next_file())) {
     if (-l $file and -d $file) {
         link_if_possible($file) if ($opt_l);
@@ -186,9 +186,10 @@
                       print OUT $t,"unless(defined(\&$name)) {\n    sub $name () {\t",$new,";}\n}\n";
 		    }
 		}
-	    } elsif (/^(include|import|include_next)\s*[<\"](.*)[>\"]/) {
+	    } elsif (/^(include|import|include_next)\s*([<\"])(.*)[>\"]/) {
                 $incl_type = $1;
-                $incl = $2;
+                $incl_quote = $2;
+                $incl = $3;
                 if (($incl_type eq 'include_next') ||
                     ($opt_e && exists($bad_file{$incl}))) {
                     $incl =~ s/\.h$/.ph/;
@@ -221,6 +222,10 @@
 			   "warn(\$\@) if \$\@;\n");
                 } else {
                     $incl =~ s/\.h$/.ph/;
+                    # copy the prefix in the quote syntax (#include "x.h") case
+                    if ($incl !~ m|/| && $incl_quote eq q{"} && $file =~ m|^(.*)/|) {
+                        $incl = "$1/$incl";
+                    }
 		    print OUT $t,"require '$incl';\n";
                 }
 	    } elsif (/^ifdef\s+(\w+)/) {
@@ -724,8 +729,13 @@
                 $line .= <HEADER>;
             }
 
-            if ($line =~ /^#\s*include\s+<(.*?)>/) {
-                push(@ARGV, $1) unless $Is_converted{$1};
+            if ($line =~ /^#\s*include\s+([<"])(.*?)[>"]/) {
+                my ($delimiter, $new_file) = ($1, $2);
+                # copy the prefix in the quote syntax (#include "x.h") case
+                if ($delimiter eq q{"} && $file =~ m|^(.*)/|) {
+                    $new_file = "$1/$new_file";
+                }
+                push(@ARGV, $new_file) unless $Is_converted{$new_file};
             }
         }
     close HEADER;
End of Patch.



Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About