Upgrade to Devel::PPPort 3.11_05

p4raw-id: //depot/perl@31739

20 files changed, 381 insertions, 102 deletions

diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes
index 7a481365e4..5ec01581a0 100755
--- a/ext/Devel/PPPort/Changes
+++ b/ext/Devel/PPPort/Changes
@@ -1,3 +1,32 @@
+3.11_05 - 2007-08-20
+
+    * fix: PERL_HASH() was emitting a warning when passed in a
+      const char pointer
+    * fix: sv_magic_portable() was emitting a warning when
+      passed in a const char pointer
+    * fix: make sure arguments to sv_magic_portable() are only
+      evaluated once
+
+3.11_04 - 2007-08-20
+
+    * fix: ignore strings and XS comments when scanning and
+      patching files
+    * added support for the following API
+        newSVpvn_share
+        PERL_HASH
+        SvSHARED_HASH
+    * use PERL_BCDREVISION for version checking to save some
+      bytes in ppport.h
+    * improve the --strip option
+      - strip all C comments
+      - strip most superfluous whitespace
+      with these changes, the stripped ppport.h is now almost
+      30% smaller:
+                       3.11_03   3.11_04     delta
+        ------------------------------------------
+        uncompressed     87988     62573    -28.9%
+        gzip'd           17985     12725    -29.2%
+
 3.11_03 - 2007-08-14
 
     * fix an infinite recursion in ppport.h that could be
diff --git a/ext/Devel/PPPort/MANIFEST.SKIP b/ext/Devel/PPPort/MANIFEST.SKIP
index e0a5ec7701..4df9284b91 100644
--- a/ext/Devel/PPPort/MANIFEST.SKIP
+++ b/ext/Devel/PPPort/MANIFEST.SKIP
@@ -14,4 +14,5 @@
 ^parts/base-
 ^ppport\.h$
 ^PPPort\.c$
+^testing
 Devel-PPPort.*\.tar\.gz$
diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL
index d5dcbe6ca4..0b682a7294 100644
--- a/ext/Devel/PPPort/PPPort_pm.PL
+++ b/ext/Devel/PPPort/PPPort_pm.PL
@@ -4,9 +4,9 @@
 #
 ################################################################################
 #
-#  $Revision: 54 $
+#  $Revision: 55 $
 #  $Author: mhx $
-#  $Date: 2007/08/13 00:03:11 +0200 $
+#  $Date: 2007/08/19 19:41:37 +0200 $
 #
 ################################################################################
 #
@@ -344,9 +344,9 @@ __DATA__
 #
 ################################################################################
 #
-#  $Revision: 54 $
+#  $Revision: 55 $
 #  $Author: mhx $
-#  $Date: 2007/08/13 00:03:11 +0200 $
+#  $Date: 2007/08/19 19:41:37 +0200 $
 #
 ################################################################################
 #
@@ -507,7 +507,7 @@ package Devel::PPPort;
 use strict;
 use vars qw($VERSION $data);
 
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.11_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.11_05 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
 
 sub _init_data
 {
@@ -606,6 +606,8 @@ __DATA__
 
 %include sv_xpvf
 
+%include shared_pv
+
 %include warn
 
 %include pvs
diff --git a/ext/Devel/PPPort/TODO b/ext/Devel/PPPort/TODO
index ce07d8a788..dc83cc9478 100644
--- a/ext/Devel/PPPort/TODO
+++ b/ext/Devel/PPPort/TODO
@@ -1,5 +1,7 @@
 TODO:
 
+* bump __MAX_PERL__ before 5.10
+
 * > 3. In several cases, "perl ppport.h --copy=.new" output a new file in
   > which the only change was the addition of "#include "ppport.h"". In each
   > case, that actually wasn't necessary because the source file in question
diff --git a/ext/Devel/PPPort/parts/apicheck.pl b/ext/Devel/PPPort/parts/apicheck.pl
index 41ac35ad3d..b18ec260ee 100644
--- a/ext/Devel/PPPort/parts/apicheck.pl
+++ b/ext/Devel/PPPort/parts/apicheck.pl
@@ -5,9 +5,9 @@
 #
 ################################################################################
 #
-#  $Revision: 25 $
+#  $Revision: 27 $
 #  $Author: mhx $
-#  $Date: 2007/08/12 23:23:40 +0200 $
+#  $Date: 2007/08/19 19:41:03 +0200 $
 #
 ################################################################################
 #
@@ -154,11 +154,12 @@ print OUT <<HEAD;
 #define NEED_my_strlcpy
 #define NEED_newCONSTSUB
 #define NEED_newRV_noinc
+#define NEED_newSVpvn_share
 #define NEED_sv_2pv_flags
-#define NEED_sv_pvn_force_flags
 #define NEED_sv_2pvbyte
 #define NEED_sv_catpvf_mg
 #define NEED_sv_catpvf_mg_nocontext
+#define NEED_sv_pvn_force_flags
 #define NEED_sv_setpvf_mg
 #define NEED_sv_setpvf_mg_nocontext
 #define NEED_vload_module
diff --git a/ext/Devel/PPPort/parts/base/5004000 b/ext/Devel/PPPort/parts/base/5004000
index 41a7f96474..31436dd43c 100644
--- a/ext/Devel/PPPort/parts/base/5004000
+++ b/ext/Devel/PPPort/parts/base/5004000
@@ -85,3 +85,4 @@ SvUVXx                         # added by devel/scanprov
 boolSV                         # added by devel/scanprov
 memEQ                          # added by devel/scanprov
 memNE                          # added by devel/scanprov
+PERL_HASH                      # added by devel/scanprov
diff --git a/ext/Devel/PPPort/parts/base/5009003 b/ext/Devel/PPPort/parts/base/5009003
index 0bd2b615f2..8e6ee44a46 100644
--- a/ext/Devel/PPPort/parts/base/5009003
+++ b/ext/Devel/PPPort/parts/base/5009003
@@ -58,3 +58,4 @@ SvPV_mutable                   # added by devel/scanprov
 SvPV_nolen_const               # added by devel/scanprov
 SvPV_nomg_const                # added by devel/scanprov
 SvPV_nomg_const_nolen          # added by devel/scanprov
+SvSHARED_HASH                  # added by devel/scanprov
diff --git a/ext/Devel/PPPort/parts/inc/call b/ext/Devel/PPPort/parts/inc/call
index daba216c34..ef7bbc852a 100644
--- a/ext/Devel/PPPort/parts/inc/call
+++ b/ext/Devel/PPPort/parts/inc/call
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 14 $
+##  $Revision: 15 $
 ##  $Author: mhx $
-##  $Date: 2007/08/12 23:57:09 +0200 $
+##  $Date: 2007/08/18 20:16:11 +0200 $
 ##
 ################################################################################
 ##
@@ -331,5 +331,5 @@ ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
 ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
 
 ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
-Devel::PPPort::load_module(0, "less", undef);  
+Devel::PPPort::load_module(0, "less", undef);
 ok(defined $::{'less::'}, 1, "Have now loaded less");
diff --git a/ext/Devel/PPPort/parts/inc/magic b/ext/Devel/PPPort/parts/inc/magic
index b6358cb68d..48064e3c43 100644
--- a/ext/Devel/PPPort/parts/inc/magic
+++ b/ext/Devel/PPPort/parts/inc/magic
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 13 $
+##  $Revision: 14 $
 ##  $Author: mhx $
-##  $Date: 2007/08/12 23:24:34 +0200 $
+##  $Date: 2007/08/20 19:19:24 +0200 $
 ##
 ################################################################################
 ##
@@ -181,20 +181,23 @@ __UNDEFINED__  SvVSTRING_mg(sv)  (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring
 
 #elif { VERSION < 5.8.0 }
 
-#  define sv_magic_portable(sv, obj, how, name, namlen)         \
-   STMT_START {                                                 \
-     if (name && namlen == 0)                                   \
-     {                                                          \
-       MAGIC *mg;                                               \
-       sv_magic(sv, obj, how, 0, 0);                            \
-       mg = SvMAGIC(sv);                                        \
-       mg->mg_len = -42; /* XXX: this is the tricky part */     \
-       mg->mg_ptr = name;                                       \
-     }                                                          \
-     else                                                       \
-     {                                                          \
-       sv_magic(sv, obj, how, name, namlen);                    \
-     }                                                          \
+#  define sv_magic_portable(sv, obj, how, name, namlen)     \
+   STMT_START {                                             \
+     SV *SvMp_sv = (sv);                                    \
+     char *SvMp_name = (char *) (name);                     \
+     I32 SvMp_namlen = (namlen);                            \
+     if (SvMp_name && SvMp_namlen == 0)                     \
+     {                                                      \
+       MAGIC *mg;                                           \
+       sv_magic(SvMp_sv, obj, how, 0, 0);                   \
+       mg = SvMAGIC(SvMp_sv);                               \
+       mg->mg_len = -42; /* XXX: this is the tricky part */ \
+       mg->mg_ptr = SvMp_name;                              \
+     }                                                      \
+     else                                                   \
+     {                                                      \
+       sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
+     }                                                      \
    } STMT_END
 
 #else
diff --git a/ext/Devel/PPPort/parts/inc/misc b/ext/Devel/PPPort/parts/inc/misc
index 847445ec34..c565e21dff 100644
--- a/ext/Devel/PPPort/parts/inc/misc
+++ b/ext/Devel/PPPort/parts/inc/misc
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 39 $
+##  $Revision: 41 $
 ##  $Author: mhx $
-##  $Date: 2007/07/18 13:09:15 +0200 $
+##  $Date: 2007/08/20 18:33:10 +0200 $
 ##
 ################################################################################
 ##
@@ -28,6 +28,7 @@ NVTYPE
 INT2PTR
 PTRV
 NUM2PTR
+PERL_HASH
 PTR2IV
 PTR2UV
 PTR2NV
@@ -214,7 +215,17 @@ __UNDEFINED__  dVAR            dNOOP
 
 __UNDEFINED__  SVf             "_"
 
-__UNDEFINED__ UTF8_MAXBYTES    UTF8_MAXLEN
+__UNDEFINED__  UTF8_MAXBYTES   UTF8_MAXLEN
+
+__UNDEFINED__  PERL_HASH(hash,str,len) \
+     STMT_START	{ \
+	const char *s_PeRlHaSh = str; \
+	I32 i_PeRlHaSh = len; \
+	U32 hash_PeRlHaSh = 0; \
+	while (i_PeRlHaSh--) \
+	    hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
+	(hash) = hash_PeRlHaSh; \
+    } STMT_END
 
 =xsmisc
 
diff --git a/ext/Devel/PPPort/parts/inc/ppphbin b/ext/Devel/PPPort/parts/inc/ppphbin
index 08b74366f1..3a1c1ebbbe 100644
--- a/ext/Devel/PPPort/parts/inc/ppphbin
+++ b/ext/Devel/PPPort/parts/inc/ppphbin
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 41 $
+##  $Revision: 44 $
 ##  $Author: mhx $
-##  $Date: 2007/08/13 21:08:26 +0200 $
+##  $Date: 2007/08/20 18:21:09 +0200 $
 ##
 ################################################################################
 ##
@@ -21,6 +21,9 @@
 
 use strict;
 
+# Disable broken TRIE-optimization
+BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
+
 my $VERSION = __VERSION__;
 
 my %opt = (
@@ -38,6 +41,12 @@ my($ppport) = $0 =~ /([\w.]+)$/;
 my $LF = '(?:\r\n|[\r\n])';   # line feed
 my $HS = "[ \t]";             # horizontal whitespace
 
+# Never use C comments in this file!
+my $ccs  = '/'.'*';
+my $cce  = '*'.'/';
+my $rccs = quotemeta $ccs;
+my $rcce = quotemeta $cce;
+
 eval {
   require Getopt::Long;
   Getopt::Long::GetOptions(\%opt, qw(
@@ -73,12 +82,6 @@ else {
   $opt{'compat-version'} = 5;
 }
 
-# Never use C comments in this file!!!!!
-my $ccs  = '/'.'*';
-my $cce  = '*'.'/';
-my $rccs = quotemeta $ccs;
-my $rcce = quotemeta $cce;
-
 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
                 ? ( $1 => {
                       ($2                  ? ( base     => $2 ) : ()),
@@ -110,11 +113,9 @@ sub find_api
 {
   my $code = shift;
   $code =~ s{
-    ([^"'/]+)
-  | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
-  | (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
-  | (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
-  }{ defined $1 ? $1 : '' }egsx;
+    / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
+  | "[^"\\]*(?:\\.[^"\\]*)*"
+  | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
   grep { exists $API{$_} } $code =~ /(\w+)/mg;
 }
 
@@ -127,12 +128,11 @@ while (<DATA>) {
         $h->{$_} .= "$1\n";
       }
     }
-    else {
-      undef $hint;
-    }
+    else { undef $hint }
   }
 
-  $hint = [$1, [split /,?\s+/, $2]] if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
+  $hint = [$1, [split /,?\s+/, $2]]
+      if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
 
   if ($define) {
     if ($define->[1] =~ /\\$/) {
@@ -203,17 +203,11 @@ if (exists $opt{'api-info'}) {
       print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
       $info++;
     }
-    unless ($info) {
-      print "No portability information available.\n";
-    }
+    print "No portability information available.\n" unless $info;
     $count++;
   }
-  if ($count > 0) {
-    print "\n";
-  }
-  else {
-    print "Found no API matching '$opt{'api-info'}'.\n";
-  }
+  $count or print "Found no API matching '$opt{'api-info'}'.";
+  print "\n";
   exit 0;
 }
 
@@ -278,9 +272,7 @@ if (!@ARGV || $opt{filter}) {
   @files = @in;
 }
 
-unless (@files) {
-  die "No input files given!\n";
-}
+die "No input files given!\n" unless @files;
 
 my(%files, %global, %revreplace);
 %revreplace = reverse %replace;
@@ -300,20 +292,22 @@ for $filename (@files) {
 
   my %file = (orig => $c, changes => 0);
 
-  # temporarily remove C comments from the code
+  # Temporarily remove C/XS comments and strings from the code
   my @ccom;
+
   $c =~ s{
-    ( [^"'/]+
-    | (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
-    | (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+ )
-  | (/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
-         | /[^\r\n]* ) )
+    ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
+    | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
+  | ( ^$HS*\#[^\r\n]*
+    | "[^"\\]*(?:\\.[^"\\]*)*"
+    | '[^'\\]*(?:\\.[^'\\]*)*'
+    | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
   }{ defined $2 and push @ccom, $2;
-     defined $1 ? $1 : "$ccs$#ccom$cce" }egsx;
+     defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
 
   $file{ccom} = \@ccom;
   $file{code} = $c;
-  $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
+  $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
 
   my $func;
 
@@ -335,9 +329,7 @@ for $filename (@files) {
             }
           }
           for ($func, @deps) {
-            if (exists $need{$_}) {
-              $file{needs}{$_} = 'static';
-            }
+            $file{needs}{$_} = 'static' if exists $need{$_};
           }
         }
       }
@@ -353,9 +345,7 @@ for $filename (@files) {
     if (exists $need{$2}) {
       $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
     }
-    else {
-      warning("Possibly wrong #define $1 in $filename");
-    }
+    else { warning("Possibly wrong #define $1 in $filename") }
   }
 
   for (qw(uses needs uses_todo needed_global needed_static)) {
@@ -590,6 +580,8 @@ exit 0;
 
 #######################################################################
 
+sub try_use { eval "use @_;"; return $@ eq '' }
+
 sub mydiff
 {
   local *F = shift;
@@ -600,7 +592,7 @@ sub mydiff
     $diff = run_diff($opt{diff}, $file, $str);
   }
 
-  if (!defined $diff and can_use('Text::Diff')) {
+  if (!defined $diff and try_use('Text::Diff')) {
     $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
     $diff = <<HEADER . $diff;
 --- $file
@@ -622,7 +614,6 @@ HEADER
   }
 
   print F $diff;
-
 }
 
 sub run_diff
@@ -659,12 +650,6 @@ sub run_diff
   return undef;
 }
 
-sub can_use
-{
-  eval "use @_;";
-  return $@ eq '';
-}
-
 sub rec_depend
 {
   my($func, $seen) = @_;
@@ -819,9 +804,19 @@ please try to regenerate this file using:
 
 END
 /ms;
+  my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
+  $c =~ s{
+    / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
+  | ( "[^"\\]*(?:\\.[^"\\]*)*"
+    | '[^'\\]*(?:\\.[^'\\]*)*' )
+  | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
+  $c =~ s!\s+$!!mg;
+  $c =~ s!^$LF!!mg;
+  $c =~ s!^\s*#\s*!#!mg;
+  $c =~ s!^\s+!!mg;
 
   open OUT, ">$0" or die "cannot strip $0: $!\n";
-  print OUT $self;
+  print OUT "$pl$c\n";
 
   exit 0;
 }
diff --git a/ext/Devel/PPPort/parts/inc/ppphtest b/ext/Devel/PPPort/parts/inc/ppphtest
index 9534508b4e..d1cd7aa7f4 100644
--- a/ext/Devel/PPPort/parts/inc/ppphtest
+++ b/ext/Devel/PPPort/parts/inc/ppphtest
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 38 $
+##  $Revision: 40 $
 ##  $Author: mhx $
-##  $Date: 2007/08/12 23:58:29 +0200 $
+##  $Date: 2007/08/20 18:06:48 +0200 $
 ##
 ################################################################################
 ##
@@ -15,11 +15,11 @@
 ##
 ################################################################################
 
-=tests plan => 221
+=tests plan => 225
 
 BEGIN {
   if ($ENV{'SKIP_SLOW_TESTS'}) {
-    for (1 .. 221) {
+    for (1 .. 225) {
       skip("skip: SKIP_SLOW_TESTS", 0);
     }
     exit 0;
@@ -132,6 +132,7 @@ for (split /\s*={70,}\s*/, do { local $/; <DATA> }) {
 
 my $t;
 for $t (@tests) {
+  print "#\n", ('# ', '-'x70, "\n")x3, "#\n";
   my $f;
   for $f (keys %{$t->{files}}) {
     my @f = split /\//, $f;
@@ -149,6 +150,11 @@ for $t (@tests) {
     print "# *** writing $f ***\n$txt\n";
   }
 
+  my $code = $t->{code};
+  $code =~ s/^/# | /mg;
+
+  print "# *** evaluating test code ***\n$code\n";
+
   eval $t->{code};
   if ($@) {
     my $err = $@;
@@ -806,3 +812,41 @@ ok($o =~ /^Looks good/m);
 SvUOK
 PL_copline
 
+===============================================================================
+
+my $o = ppport(qw(--copy=f));
+
+for (qw(file.xs)) {
+  ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi);
+  ok(-e "${_}f");
+  ok(eq_files("${_}f", "${_}r"));
+  unlink "${_}f";
+}
+
+---------------------------- file.xs -----------------------------------------
+
+a_string = "sv_undef"
+a_char = 'sv_yes'
+#define SOMETHING defgv
+/* C-comment: sv_tainted */
+#
+# This is just a big XS comment using sv_no
+#
+/* The following, is NOT an XS comment! */
+#  define SOMETHING_ELSE defgv + \
+                         sv_undef
+
+---------------------------- file.xsr -----------------------------------------
+
+#include "ppport.h"
+a_string = "sv_undef"
+a_char = 'sv_yes'
+#define SOMETHING PL_defgv
+/* C-comment: sv_tainted */
+#
+# This is just a big XS comment using sv_no
+#
+/* The following, is NOT an XS comment! */
+#  define SOMETHING_ELSE PL_defgv + \
+                         PL_sv_undef
+
diff --git a/ext/Devel/PPPort/parts/inc/shared_pv b/ext/Devel/PPPort/parts/inc/shared_pv
new file mode 100644
index 0000000000..8fbf4c8dbf
--- /dev/null
+++ b/ext/Devel/PPPort/parts/inc/shared_pv
@@ -0,0 +1,91 @@
+################################################################################
+##
+##  $Revision: 1 $
+##  $Author: mhx $
+##  $Date: 2007/08/19 19:38:17 +0200 $
+##
+################################################################################
+##
+##  Version 3.x, Copyright (C) 2004-2007, Marcus Holland-Moritz.
+##  Version 2.x, Copyright (C) 2001, Paul Marquess.
+##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+##
+##  This program is free software; you can redistribute it and/or
+##  modify it under the same terms as Perl itself.
+##
+################################################################################
+
+=provides
+
+newSVpvn_share
+__UNDEFINED__
+
+=implementation
+
+#ifndef newSVpvn_share
+
+#if { NEED newSVpvn_share }
+
+SV *
+newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
+{
+  SV *sv;
+  if (len < 0)
+    len = -len;
+  if (!hash)
+    PERL_HASH(hash, src, len);
+  sv = newSVpvn((char *) src, len);
+  sv_upgrade(sv, SVt_PVIV);
+  SvIVX(sv) = hash;
+  SvREADONLY_on(sv);
+  SvPOK_on(sv);
+  return sv;
+}
+
+#endif
+
+#endif
+
+__UNDEFINED__ SvSHARED_HASH(sv) (0 + SvUVX(sv))
+
+=xsinit
+
+#define NEED_newSVpvn_share
+
+=xsubs
+
+int
+newSVpvn_share()
+	PREINIT:
+		const char *s;
+		SV *sv;
+		STRLEN len;
+		U32 hash;
+	CODE:
+		RETVAL = 0;
+		s = "mhx";
+		len = 3;
+		PERL_HASH(hash, s, len);
+		sv = newSVpvn_share(s, len, 0);
+		s = 0;
+		RETVAL += strEQ(SvPV_nolen_const(sv), "mhx");
+		RETVAL += SvCUR(sv) == len;
+		RETVAL += SvSHARED_HASH(sv) == hash;
+		SvREFCNT_dec(sv);
+		s = "foobar";
+		len = 6;
+		PERL_HASH(hash, s, len);
+		sv = newSVpvn_share(s, -len, hash);
+		s = 0;
+		RETVAL += strEQ(SvPV_nolen_const(sv), "foobar");
+		RETVAL += SvCUR(sv) == len;
+		RETVAL += SvSHARED_HASH(sv) == hash;
+		SvREFCNT_dec(sv);
+	OUTPUT:
+		RETVAL
+
+
+=tests plan => 1
+
+ok(&Devel::PPPort::newSVpvn_share(), 6);
+
diff --git a/ext/Devel/PPPort/parts/inc/threads b/ext/Devel/PPPort/parts/inc/threads
index a183c8f7a3..6002743b72 100644
--- a/ext/Devel/PPPort/parts/inc/threads
+++ b/ext/Devel/PPPort/parts/inc/threads
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 8 $
+##  $Revision: 9 $
 ##  $Author: mhx $
-##  $Date: 2007/01/02 12:32:32 +0100 $
+##  $Date: 2007/08/18 20:16:12 +0200 $
 ##
 ################################################################################
 ##
@@ -37,7 +37,7 @@ __UNDEFINED__  aTHX_
 #if { VERSION < 5.6.0 }
 #  ifdef USE_THREADS
 #    define aTHXR  thr
-#    define aTHXR_ thr, 
+#    define aTHXR_ thr,
 #  else
 #    define aTHXR
 #    define aTHXR_
diff --git a/ext/Devel/PPPort/parts/ppptools.pl b/ext/Devel/PPPort/parts/ppptools.pl
index 06a2c2ec98..f8227a83c6 100644
--- a/ext/Devel/PPPort/parts/ppptools.pl
+++ b/ext/Devel/PPPort/parts/ppptools.pl
@@ -4,9 +4,9 @@
 #
 ################################################################################
 #
-#  $Revision: 19 $
+#  $Revision: 22 $
 #  $Author: mhx $
-#  $Date: 2007/08/13 22:59:58 +0200 $
+#  $Date: 2007/08/19 01:18:23 +0200 $
 #
 ################################################################################
 #
@@ -68,10 +68,8 @@ sub expand_version
   my($op, $ver) = @_;
   my($r, $v, $s) = parse_version($ver);
   $r == 5 or die "only Perl revision 5 is supported\n";
-  $op eq '=='     and return "((PERL_VERSION == $v) && (PERL_SUBVERSION == $s))";
-  $op eq '!='     and return "((PERL_VERSION != $v) || (PERL_SUBVERSION != $s))";
-  $op =~ /([<>])/ and return "((PERL_VERSION $1 $v) || ((PERL_VERSION == $v) && (PERL_SUBVERSION $op $s)))";
-  die "cannot expand version expression ($op $ver)\n";
+  my $bcdver = sprintf "0x%d%03d%03d", $r, $v, $s;
+  return "(PERL_BCDVERSION $op $bcdver)";
 }
 
 sub parse_partspec
@@ -85,13 +83,18 @@ sub parse_partspec
 
   open F, $file or die "$file: $!\n";
   while (<F>) {
+    /[ \t]+$/ and warn "$file:$.: warning: trailing whitespace\n";
+    if ($section eq 'implementation') {
+      m!//! && !m!(?:=~|s/).*//! && !m!(?:ht|f)tp://!
+          and warn "$file:$.: warning: potential C++ comment\n";
+    }
     /^##/ and next;
     if (/^=($vsec)(?:\s+(.*))?/) {
       $section = $1;
       if (defined $2) {
         my $opt = $2;
         $options{$section} = eval "{ $opt }";
-        $@ and die "Invalid options ($opt) in section $section of $file: $@\n";
+        $@ and die "$file:$.: invalid options ($opt) in section $section: $@\n";
       }
       next;
     }
diff --git a/ext/Devel/PPPort/parts/todo/5007001 b/ext/Devel/PPPort/parts/todo/5007001
index d630ba6e8b..56f6d3edba 100644
--- a/ext/Devel/PPPort/parts/todo/5007001
+++ b/ext/Devel/PPPort/parts/todo/5007001
@@ -6,7 +6,6 @@ do_openn                       # U
 gv_handler                     # U
 is_lvalue_sub                  # U
 my_popen_list                  # U
-newSVpvn_share                 # U
 save_mortalizesv               # U
 save_padsv                     # U
 scan_num                       # E (Perl_scan_num)
diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak
index a8cc4b391d..242e5adb62 100644
--- a/ext/Devel/PPPort/soak
+++ b/ext/Devel/PPPort/soak
@@ -33,7 +33,7 @@ use File::Find;
 use List::Util qw(max);
 use Config;
 
-my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.11_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.11_05 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
 
 $| = 1;
 my %OPT = (
diff --git a/ext/Devel/PPPort/t/call.t b/ext/Devel/PPPort/t/call.t
index beecf3d888..6a5da7079a 100644
--- a/ext/Devel/PPPort/t/call.t
+++ b/ext/Devel/PPPort/t/call.t
@@ -101,6 +101,6 @@ ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
 ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
 
 ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
-Devel::PPPort::load_module(0, "less", undef);  
+Devel::PPPort::load_module(0, "less", undef);
 ok(defined $::{'less::'}, 1, "Have now loaded less");
 
diff --git a/ext/Devel/PPPort/t/ppphtest.t b/ext/Devel/PPPort/t/ppphtest.t
index e0af34fb17..f84f21befb 100644
--- a/ext/Devel/PPPort/t/ppphtest.t
+++ b/ext/Devel/PPPort/t/ppphtest.t
@@ -30,9 +30,9 @@ BEGIN {
     require 'testutil.pl' if $@;
   }
 
-  if (221) {
+  if (225) {
     load();
-    plan(tests => 221);
+    plan(tests => 225);
   }
 }
 
@@ -50,7 +50,7 @@ package main;
 
 BEGIN {
   if ($ENV{'SKIP_SLOW_TESTS'}) {
-    for (1 .. 221) {
+    for (1 .. 225) {
       skip("skip: SKIP_SLOW_TESTS", 0);
     }
     exit 0;
@@ -163,6 +163,7 @@ for (split /\s*={70,}\s*/, do { local $/; <DATA> }) {
 
 my $t;
 for $t (@tests) {
+  print "#\n", ('# ', '-'x70, "\n")x3, "#\n";
   my $f;
   for $f (keys %{$t->{files}}) {
     my @f = split /\//, $f;
@@ -180,6 +181,11 @@ for $t (@tests) {
     print "# *** writing $f ***\n$txt\n";
   }
 
+  my $code = $t->{code};
+  $code =~ s/^/# | /mg;
+
+  print "# *** evaluating test code ***\n$code\n";
+
   eval $t->{code};
   if ($@) {
     my $err = $@;
@@ -837,3 +843,41 @@ ok($o =~ /^Looks good/m);
 SvUOK
 PL_copline
 
+===============================================================================
+
+my $o = ppport(qw(--copy=f));
+
+for (qw(file.xs)) {
+  ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi);
+  ok(-e "${_}f");
+  ok(eq_files("${_}f", "${_}r"));
+  unlink "${_}f";
+}
+
+---------------------------- file.xs -----------------------------------------
+
+a_string = "sv_undef"
+a_char = 'sv_yes'
+#define SOMETHING defgv
+/* C-comment: sv_tainted */
+#
+# This is just a big XS comment using sv_no
+#
+/* The following, is NOT an XS comment! */
+#  define SOMETHING_ELSE defgv + \
+                         sv_undef
+
+---------------------------- file.xsr -----------------------------------------
+
+#include "ppport.h"
+a_string = "sv_undef"
+a_char = 'sv_yes'
+#define SOMETHING PL_defgv
+/* C-comment: sv_tainted */
+#
+# This is just a big XS comment using sv_no
+#
+/* The following, is NOT an XS comment! */
+#  define SOMETHING_ELSE PL_defgv + \
+                         PL_sv_undef
+
diff --git a/ext/Devel/PPPort/t/shared_pv.t b/ext/Devel/PPPort/t/shared_pv.t
new file mode 100644
index 0000000000..3e7ed54fc7
--- /dev/null
+++ b/ext/Devel/PPPort/t/shared_pv.t
@@ -0,0 +1,52 @@
+################################################################################
+#
+#            !!!!!   Do NOT edit this file directly!   !!!!!
+#
+#            Edit mktests.PL and/or parts/inc/shared_pv instead.
+#
+#  This file was automatically generated from the definition files in the
+#  parts/inc/ subdirectory by mktests.PL. To learn more about how all this
+#  works, please read the F<HACKERS> file that came with this distribution.
+#
+################################################################################
+
+BEGIN {
+  if ($ENV{'PERL_CORE'}) {
+    chdir 't' if -d 't';
+    @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+    require Config; import Config;
+    use vars '%Config';
+    if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
+      print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+      exit 0;
+    }
+  }
+  else {
+    unshift @INC, 't';
+  }
+
+  sub load {
+    eval "use Test";
+    require 'testutil.pl' if $@;
+  }
+
+  if (1) {
+    load();
+    plan(tests => 1);
+  }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+package Devel::PPPort;
+use vars '@ISA';
+require DynaLoader;
+@ISA = qw(DynaLoader);
+bootstrap Devel::PPPort;
+
+package main;
+
+ok(&Devel::PPPort::newSVpvn_share(), 6);
+