From: Marcus Holland-Moritz Date: Mon, 20 Aug 2007 17:31:12 +0000 (+0000) Subject: Upgrade to Devel::PPPort 3.11_05 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c83e6f195f905dd4809cef6ea71ef6cef8c9f7b8;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Devel::PPPort 3.11_05 p4raw-id: //depot/perl@31739 --- diff --git a/MANIFEST b/MANIFEST index 38edcca..42adc8f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -274,6 +274,7 @@ ext/Devel/PPPort/parts/inc/ppphbin Devel::PPPort include 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/TODO Devel::PPPort Todo 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 diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes index 7a48136..5ec0158 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 e0a5ec7..4df9284 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 d5dcbe6..0b682a7 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 ce07d8a..dc83cc9 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 41ac35a..b18ec26 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 <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 847445e..c565e21 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 08b7436..3a1c1eb 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 () { $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 = <
$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 9534508..d1cd7aa 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 $/; }) { 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 0000000..8fbf4c8 --- /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 a183c8f..6002743 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 06a2c2e..f8227a8 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 () { + /[ \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 d630ba6..56f6d3e 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 a8cc4b3..242e5ad 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 beecf3d..6a5da70 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 e0af34f..f84f21b 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 $/; }) { 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 0000000..3e7ed54 --- /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 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); +