Change 31739 by [EMAIL PROTECTED] on 2007/08/20 17:31:12
Upgrade to Devel::PPPort 3.11_05
Affected files ...
... //depot/perl/MANIFEST#1615 edit
... //depot/perl/ext/Devel/PPPort/Changes#38 edit
... //depot/perl/ext/Devel/PPPort/MANIFEST.SKIP#3 edit
... //depot/perl/ext/Devel/PPPort/PPPort_pm.PL#31 edit
... //depot/perl/ext/Devel/PPPort/TODO#16 edit
... //depot/perl/ext/Devel/PPPort/parts/apicheck.pl#12 edit
... //depot/perl/ext/Devel/PPPort/parts/base/5004000#5 edit
... //depot/perl/ext/Devel/PPPort/parts/base/5009003#6 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/call#7 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/magic#7 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/misc#14 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/ppphbin#12 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/ppphtest#15 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/shared_pv#1 add
... //depot/perl/ext/Devel/PPPort/parts/inc/threads#6 edit
... //depot/perl/ext/Devel/PPPort/parts/ppptools.pl#11 edit
... //depot/perl/ext/Devel/PPPort/parts/todo/5007001#5 edit
... //depot/perl/ext/Devel/PPPort/soak#26 edit
... //depot/perl/ext/Devel/PPPort/t/call.t#7 edit
... //depot/perl/ext/Devel/PPPort/t/ppphtest.t#16 edit
... //depot/perl/ext/Devel/PPPort/t/shared_pv.t#1 add
Differences ...
==== //depot/perl/MANIFEST#1615 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1614~31732~ 2007-08-18 01:03:28.000000000 -0700
+++ perl/MANIFEST 2007-08-20 10:31:12.000000000 -0700
@@ -274,6 +274,7 @@
ext/Devel/PPPort/parts/inc/ppphdoc Devel::PPPort include
ext/Devel/PPPort/parts/inc/ppphtest Devel::PPPort include
ext/Devel/PPPort/parts/inc/pvs Devel::PPPort include
+ext/Devel/PPPort/parts/inc/shared_pv Devel::PPPort include
ext/Devel/PPPort/parts/inc/snprintf Devel::PPPort include
ext/Devel/PPPort/parts/inc/strlfuncs Devel::PPPort include
ext/Devel/PPPort/parts/inc/SvPV Devel::PPPort include
@@ -342,6 +343,7 @@
ext/Devel/PPPort/t/podtest.t Devel::PPPort test file
ext/Devel/PPPort/t/ppphtest.t Devel::PPPort test file
ext/Devel/PPPort/t/pvs.t Devel::PPPort test file
+ext/Devel/PPPort/t/shared_pv.t Devel::PPPort test file
ext/Devel/PPPort/t/snprintf.t Devel::PPPort test file
ext/Devel/PPPort/t/strlfuncs.t Devel::PPPort test file
ext/Devel/PPPort/t/SvPV.t Devel::PPPort test file
==== //depot/perl/ext/Devel/PPPort/Changes#38 (xtext) ====
Index: perl/ext/Devel/PPPort/Changes
--- perl/ext/Devel/PPPort/Changes#37~31713~ 2007-08-14 12:22:20.000000000
-0700
+++ perl/ext/Devel/PPPort/Changes 2007-08-20 10:31:12.000000000 -0700
@@ -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
==== //depot/perl/ext/Devel/PPPort/MANIFEST.SKIP#3 (text) ====
Index: perl/ext/Devel/PPPort/MANIFEST.SKIP
--- perl/ext/Devel/PPPort/MANIFEST.SKIP#2~23912~ 2005-01-31
10:07:29.000000000 -0800
+++ perl/ext/Devel/PPPort/MANIFEST.SKIP 2007-08-20 10:31:12.000000000 -0700
@@ -14,4 +14,5 @@
^parts/base-
^ppport\.h$
^PPPort\.c$
+^testing
Devel-PPPort.*\.tar\.gz$
==== //depot/perl/ext/Devel/PPPort/PPPort_pm.PL#31 (text) ====
Index: perl/ext/Devel/PPPort/PPPort_pm.PL
--- perl/ext/Devel/PPPort/PPPort_pm.PL#30~31713~ 2007-08-14
12:22:20.000000000 -0700
+++ perl/ext/Devel/PPPort/PPPort_pm.PL 2007-08-20 10:31:12.000000000 -0700
@@ -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 @@
#
################################################################################
#
-# $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 @@
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 @@
%include sv_xpvf
+%include shared_pv
+
%include warn
%include pvs
==== //depot/perl/ext/Devel/PPPort/TODO#16 (text) ====
Index: perl/ext/Devel/PPPort/TODO
--- perl/ext/Devel/PPPort/TODO#15~31705~ 2007-08-12 16:17:42.000000000
-0700
+++ perl/ext/Devel/PPPort/TODO 2007-08-20 10:31:12.000000000 -0700
@@ -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
==== //depot/perl/ext/Devel/PPPort/parts/apicheck.pl#12 (text) ====
Index: perl/ext/Devel/PPPort/parts/apicheck.pl
--- perl/ext/Devel/PPPort/parts/apicheck.pl#11~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/apicheck.pl 2007-08-20 10:31:12.000000000
-0700
@@ -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 @@
#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
==== //depot/perl/ext/Devel/PPPort/parts/base/5004000#5 (text) ====
Index: perl/ext/Devel/PPPort/parts/base/5004000
--- perl/ext/Devel/PPPort/parts/base/5004000#4~28332~ 2006-05-29
10:50:48.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/base/5004000 2007-08-20 10:31:12.000000000
-0700
@@ -85,3 +85,4 @@
boolSV # added by devel/scanprov
memEQ # added by devel/scanprov
memNE # added by devel/scanprov
+PERL_HASH # added by devel/scanprov
==== //depot/perl/ext/Devel/PPPort/parts/base/5009003#6 (text) ====
Index: perl/ext/Devel/PPPort/parts/base/5009003
--- perl/ext/Devel/PPPort/parts/base/5009003#5~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/base/5009003 2007-08-20 10:31:12.000000000
-0700
@@ -58,3 +58,4 @@
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
==== //depot/perl/ext/Devel/PPPort/parts/inc/call#7 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/call
--- perl/ext/Devel/PPPort/parts/inc/call#6~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/inc/call 2007-08-20 10:31:12.000000000
-0700
@@ -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(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");
==== //depot/perl/ext/Devel/PPPort/parts/inc/magic#7 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/magic
--- perl/ext/Devel/PPPort/parts/inc/magic#6~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/inc/magic 2007-08-20 10:31:12.000000000
-0700
@@ -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 @@
#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
==== //depot/perl/ext/Devel/PPPort/parts/inc/misc#14 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/misc
--- perl/ext/Devel/PPPort/parts/inc/misc#13~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/inc/misc 2007-08-20 10:31:12.000000000
-0700
@@ -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 @@
INT2PTR
PTRV
NUM2PTR
+PERL_HASH
PTR2IV
PTR2UV
PTR2NV
@@ -214,7 +215,17 @@
__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
==== //depot/perl/ext/Devel/PPPort/parts/inc/ppphbin#12 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/ppphbin
--- perl/ext/Devel/PPPort/parts/inc/ppphbin#11~31713~ 2007-08-14
12:22:20.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/inc/ppphbin 2007-08-20 10:31:12.000000000
-0700
@@ -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 $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 @@
$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 @@
{
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 @@
$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 @@
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 @@
@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 @@
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} = [EMAIL PROTECTED];
$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 ($func, @deps) {
- if (exists $need{$_}) {
- $file{needs}{$_} = 'static';
- }
+ $file{needs}{$_} = 'static' if exists $need{$_};
}
}
}
@@ -353,9 +345,7 @@
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 @@
#######################################################################
+sub try_use { eval "use @_;"; return $@ eq '' }
+
sub mydiff
{
local *F = shift;
@@ -600,7 +592,7 @@
$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 @@
}
print F $diff;
-
}
sub run_diff
@@ -659,12 +650,6 @@
return undef;
}
-sub can_use
-{
- eval "use @_;";
- return $@ eq '';
-}
-
sub rec_depend
{
my($func, $seen) = @_;
@@ -819,9 +804,19 @@
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;
}
==== //depot/perl/ext/Devel/PPPort/parts/inc/ppphtest#15 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/ppphtest
--- perl/ext/Devel/PPPort/parts/inc/ppphtest#14~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/inc/ppphtest 2007-08-20 10:31:12.000000000
-0700
@@ -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 @@
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 @@
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 @@
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
+
==== //depot/perl/ext/Devel/PPPort/parts/inc/shared_pv#1 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/shared_pv
--- /dev/null 2007-03-19 09:41:43.516454971 -0700
+++ perl/ext/Devel/PPPort/parts/inc/shared_pv 2007-08-20 10:31:12.000000000
-0700
@@ -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);
+
==== //depot/perl/ext/Devel/PPPort/parts/inc/threads#6 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/threads
--- perl/ext/Devel/PPPort/parts/inc/threads#5~30280~ 2007-02-14
05:23:50.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/inc/threads 2007-08-20 10:31:12.000000000
-0700
@@ -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 @@
#if { VERSION < 5.6.0 }
# ifdef USE_THREADS
# define aTHXR thr
-# define aTHXR_ thr,
+# define aTHXR_ thr,
# else
# define aTHXR
# define aTHXR_
==== //depot/perl/ext/Devel/PPPort/parts/ppptools.pl#11 (text) ====
Index: perl/ext/Devel/PPPort/parts/ppptools.pl
--- perl/ext/Devel/PPPort/parts/ppptools.pl#10~31713~ 2007-08-14
12:22:20.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/ppptools.pl 2007-08-20 10:31:12.000000000
-0700
@@ -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 @@
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 @@
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:
[EMAIL PROTECTED]";
+ $@ and die "$file:$.: invalid options ($opt) in section $section:
[EMAIL PROTECTED]";
}
next;
}
==== //depot/perl/ext/Devel/PPPort/parts/todo/5007001#5 (text) ====
Index: perl/ext/Devel/PPPort/parts/todo/5007001
--- perl/ext/Devel/PPPort/parts/todo/5007001#4~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/todo/5007001 2007-08-20 10:31:12.000000000
-0700
@@ -6,7 +6,6 @@
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)
==== //depot/perl/ext/Devel/PPPort/soak#26 (text) ====
Index: perl/ext/Devel/PPPort/soak
--- perl/ext/Devel/PPPort/soak#25~31713~ 2007-08-14 12:22:20.000000000
-0700
+++ perl/ext/Devel/PPPort/soak 2007-08-20 10:31:12.000000000 -0700
@@ -33,7 +33,7 @@
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 = (
==== //depot/perl/ext/Devel/PPPort/t/call.t#7 (text) ====
Index: perl/ext/Devel/PPPort/t/call.t
--- perl/ext/Devel/PPPort/t/call.t#6~30728~ 2007-03-23 10:21:15.000000000
-0700
+++ perl/ext/Devel/PPPort/t/call.t 2007-08-20 10:31:12.000000000 -0700
@@ -101,6 +101,6 @@
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");
==== //depot/perl/ext/Devel/PPPort/t/ppphtest.t#16 (text) ====
Index: perl/ext/Devel/PPPort/t/ppphtest.t
--- perl/ext/Devel/PPPort/t/ppphtest.t#15~31705~ 2007-08-12
16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/t/ppphtest.t 2007-08-20 10:31:12.000000000 -0700
@@ -30,9 +30,9 @@
require 'testutil.pl' if $@;
}
- if (221) {
+ if (225) {
load();
- plan(tests => 221);
+ plan(tests => 225);
}
}
@@ -50,7 +50,7 @@
BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 221) {
+ for (1 .. 225) {
skip("skip: SKIP_SLOW_TESTS", 0);
}
exit 0;
@@ -163,6 +163,7 @@
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 @@
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 @@
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
+
==== //depot/perl/ext/Devel/PPPort/t/shared_pv.t#1 (text) ====
Index: perl/ext/Devel/PPPort/t/shared_pv.t
--- /dev/null 2007-03-19 09:41:43.516454971 -0700
+++ perl/ext/Devel/PPPort/t/shared_pv.t 2007-08-20 10:31:12.000000000 -0700
@@ -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;
[EMAIL PROTECTED] = qw(DynaLoader);
+bootstrap Devel::PPPort;
+
+package main;
+
+ok(&Devel::PPPort::newSVpvn_share(), 6);
+
End of Patch.
