Change 34475: Upgrade to Devel::PPPort 3.14

Marcus Holland-Moritz

2008-10-12 20:30:05 UTC

Change 34475 by ***@mhx-r2d2 on 2008/10/12 20:23:51

Upgrade to Devel::PPPort 3.14_02

Affected files ...

... //depot/perl/MANIFEST#1731 edit
... //depot/perl/ext/Devel/PPPort/Changes#47 edit
... //depot/perl/ext/Devel/PPPort/PPPort_pm.PL#40 edit
... //depot/perl/ext/Devel/PPPort/TODO#18 edit
... //depot/perl/ext/Devel/PPPort/module2.c#9 edit
... //depot/perl/ext/Devel/PPPort/module3.c#9 edit
... //depot/perl/ext/Devel/PPPort/parts/apicheck.pl#14 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/SvPV#12 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/newCONSTSUB#8 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/ppphbin#15 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/ppphtest#18 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/snprintf#4 edit
... //depot/perl/ext/Devel/PPPort/parts/inc/sprintf#1 add
... //depot/perl/ext/Devel/PPPort/parts/inc/variables#12 edit
... //depot/perl/ext/Devel/PPPort/parts/ppptools.pl#15 edit
... //depot/perl/ext/Devel/PPPort/parts/todo/5009003#6 edit
... //depot/perl/ext/Devel/PPPort/soak#35 edit
... //depot/perl/ext/Devel/PPPort/t/SvPV.t#9 edit
... //depot/perl/ext/Devel/PPPort/t/ppphtest.t#18 edit
... //depot/perl/ext/Devel/PPPort/t/sprintf.t#1 add
... //depot/perl/ext/Devel/PPPort/t/variables.t#7 edit

Differences ...

==== //depot/perl/MANIFEST#1731 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1730~34452~ 2008-10-01 09:53:57.000000000 -0700
+++ perl/MANIFEST 2008-10-12 13:23:51.000000000 -0700
@@ -282,6 +282,7 @@
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/sprintf Devel::PPPort include
ext/Devel/PPPort/parts/inc/strlfuncs Devel::PPPort include
ext/Devel/PPPort/parts/inc/SvPV Devel::PPPort include
ext/Devel/PPPort/parts/inc/SvREFCNT Devel::PPPort include
@@ -355,6 +356,7 @@
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/sprintf.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
ext/Devel/PPPort/t/SvREFCNT.t Devel::PPPort test file

==== //depot/perl/ext/Devel/PPPort/Changes#47 (xtext) ====
Index: perl/ext/Devel/PPPort/Changes
--- perl/ext/Devel/PPPort/Changes#46~34130~ 2008-07-11 13:55:01.000000000 -0700
+++ perl/ext/Devel/PPPort/Changes 2008-10-12 13:23:51.000000000 -0700
@@ -1,3 +1,23 @@
+3.14_02 - 2008-10-12
+
+ * added support for the following API
+ my_sprintf
+ PL_linestr
+ PL_bufptr
+ PL_bufend
+ PL_lex_state
+ PL_lex_stuff
+ PL_tokenbuf
+ SvPV_renew
+ (fixes CPAN #39809 and CPAN #39808)
+ * add read/write support for
+ PL_expect
+ PL_copline
+ PL_rsfp
+ PL_rsfp_filters
+ (fixes CPAN #39802)
+ * sync my_snprintf implementation with bleadperl
+
3.14_01 - 2008-07-11

* resolve CPAN #37451: add PERLIO_FUNCS_DECL and

==== //depot/perl/ext/Devel/PPPort/PPPort_pm.PL#40 (text) ====
Index: perl/ext/Devel/PPPort/PPPort_pm.PL
--- perl/ext/Devel/PPPort/PPPort_pm.PL#39~34130~ 2008-07-11 13:55:01.000000000 -0700
+++ perl/ext/Devel/PPPort/PPPort_pm.PL 2008-10-12 13:23:51.000000000 -0700
@@ -4,9 +4,9 @@
#
################################################################################
#
-# $Revision: 59 $
+# $Revision: 61 $
# $Author: mhx $
-# $Date: 2008/01/04 10:47:38 +0100 $
+# $Date: 2008/10/12 13:54:21 +0200 $
#
################################################################################
#
@@ -189,8 +189,10 @@
)
\s*$}
{expand_undefined($2, $1, $3)}gemx;
- $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?)\s*;\s*)?$}
+ $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
{expand_need_var($1, $3, $2, $4)}gem;
+ $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
+ {expand_need_dummy_var($1, $3, $2, $4)}gem;
return $code;
}

@@ -201,12 +203,13 @@
$explicit{$var} = 'var';

my $myvar = "$DPPP(my_$var)";
+ $init = defined $init ? " = $init" : "";

my $code = <<ENDCODE;
#if defined(NEED_$var)
-static $type $myvar = $init;
+static $type $myvar$init;
#elif defined(NEED_${var}_GLOBAL)
-$type $myvar = $init;
+$type $myvar$init;
#else
extern $type $myvar;
#endif
@@ -218,6 +221,30 @@
return $code;
}

+sub expand_need_dummy_var
+{
+ my($indent, $var, $type, $init) = @_;
+
+ $explicit{$var} = 'var';
+
+ my $myvar = "$DPPP(dummy_$var)";
+ $init = defined $init ? " = $init" : "";
+
+ my $code = <<ENDCODE;
+#if defined(NEED_$var)
+static $type $myvar$init;
+#elif defined(NEED_${var}_GLOBAL)
+$type $myvar$init;
+#else
+extern $type $myvar;
+#endif
+ENDCODE
+
+ $code =~ s/^/$indent/mg;
+
+ return $code;
+}
+
sub expand_undefined
{
my($macro, $withargs, $def) = @_;
@@ -345,9 +372,9 @@
#
################################################################################
#
-# $Revision: 59 $
+# $Revision: 61 $
# $Author: mhx $
-# $Date: 2008/01/04 10:47:38 +0100 $
+# $Date: 2008/10/12 13:54:21 +0200 $
#
################################################################################
#
@@ -508,7 +535,7 @@
use strict;
use vars qw($VERSION $data);

-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };

sub _init_data
{
@@ -623,6 +650,8 @@

%include snprintf

+%include sprintf
+
%include exception

%include strlfuncs

==== //depot/perl/ext/Devel/PPPort/TODO#18 (text) ====
Index: perl/ext/Devel/PPPort/TODO
--- perl/ext/Devel/PPPort/TODO#17~31848~ 2007-09-11 14:45:40.000000000 -0700
+++ perl/ext/Devel/PPPort/TODO 2008-10-12 13:23:51.000000000 -0700
@@ -321,8 +321,6 @@

* try to make parts/apicheck.pl automatically find NEED_ #defines

-* implement snprintf with newSVpvf for >= 5.004, which is safer?
-
* add support for my_vsnprintf?

* try to perform some core consistency checks:

==== //depot/perl/ext/Devel/PPPort/module2.c#9 (text+w) ====
Index: perl/ext/Devel/PPPort/module2.c
--- perl/ext/Devel/PPPort/module2.c#8~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/module2.c 2008-10-12 13:23:51.000000000 -0700
@@ -4,9 +4,9 @@
*
********************************************************************************
*
-* $Revision: 10 $
+* $Revision: 11 $
* $Author: mhx $
-* $Date: 2008/01/04 10:47:38 +0100 $
+* $Date: 2008/10/12 20:53:51 +0200 $
*
********************************************************************************
*
@@ -29,6 +29,8 @@

#define NEED_newCONSTSUB_GLOBAL
#define NEED_PL_signals_GLOBAL
+#define NEED_PL_parser
+#define DPPP_PL_parser_NO_DUMMY
#include "ppport.h"

void call_newCONSTSUB_2(void)
@@ -40,3 +42,19 @@
{
return PL_signals;
}
+
+int no_dummy_parser_vars(int check)
+{
+ if (check == 0 || PL_parser)
+ {
+ line_t volatile my_copline;
+ line_t volatile *my_p_copline;
+ my_copline = PL_copline;
+ my_p_copline = &PL_copline;
+ PL_copline = my_copline;
+ PL_copline = *my_p_copline;
+ return 1;
+ }
+
+ return 0;
+}

==== //depot/perl/ext/Devel/PPPort/module3.c#9 (text+w) ====
Index: perl/ext/Devel/PPPort/module3.c
--- perl/ext/Devel/PPPort/module3.c#8~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/module3.c 2008-10-12 13:23:51.000000000 -0700
@@ -4,9 +4,9 @@
*
********************************************************************************
*
-* $Revision: 10 $
+* $Revision: 11 $
* $Author: mhx $
-* $Date: 2008/01/04 10:47:38 +0100 $
+* $Date: 2008/10/12 20:53:51 +0200 $
*
********************************************************************************
*
@@ -22,6 +22,7 @@
#include "EXTERN.h"
#include "perl.h"

+#define NEED_PL_parser
#define NO_XSLOCKS
#include "XSUB.h"

@@ -63,3 +64,14 @@
{
return PL_signals;
}
+
+int dummy_parser_warning(void)
+{
+ char * volatile my_bufptr;
+ char * volatile *my_p_bufptr;
+ my_bufptr = PL_bufptr;
+ my_p_bufptr = &PL_bufptr;
+ PL_bufptr = my_bufptr;
+ PL_bufptr = *my_p_bufptr;
+ return &PL_bufptr != NULL;
+}

==== //depot/perl/ext/Devel/PPPort/parts/apicheck.pl#14 (text) ====
Index: perl/ext/Devel/PPPort/parts/apicheck.pl
--- perl/ext/Devel/PPPort/parts/apicheck.pl#13~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/apicheck.pl 2008-10-12 13:23:51.000000000 -0700
@@ -5,9 +5,9 @@
#
################################################################################
#
-# $Revision: 29 $
+# $Revision: 32 $
# $Author: mhx $
-# $Date: 2008/01/04 12:02:22 +0100 $
+# $Date: 2008/10/12 20:50:38 +0200 $
#
################################################################################
#
@@ -142,6 +142,7 @@
#else

#define NEED_PL_signals
+#define NEED_PL_parser
#define NEED_eval_pv
#define NEED_grok_bin
#define NEED_grok_hex
@@ -150,6 +151,7 @@
#define NEED_grok_oct
#define NEED_load_module
#define NEED_my_snprintf
+#define NEED_my_sprintf
#define NEED_my_strlcat
#define NEED_my_strlcpy
#define NEED_newCONSTSUB

==== //depot/perl/ext/Devel/PPPort/parts/inc/SvPV#12 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/SvPV
--- perl/ext/Devel/PPPort/parts/inc/SvPV#11~33824~ 2008-05-13 12:50:23.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/inc/SvPV 2008-10-12 13:23:51.000000000 -0700
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 20 $
+## $Revision: 21 $
## $Author: mhx $
-## $Date: 2008/05/13 21:05:51 +0200 $
+## $Date: 2008/10/12 20:51:06 +0200 $
##
################################################################################
##
@@ -191,6 +191,11 @@
__UNDEFINED__ SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
__UNDEFINED__ SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)

+__UNDEFINED__ SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
+ SvPV_set((sv), (char *) saferealloc( \
+ (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
+ } STMT_END
+
=xsinit

#define NEED_sv_2pv_flags
@@ -432,8 +437,25 @@
OUTPUT:
RETVAL

+void
+SvPV_renew(sv, nlen, insv)
+ SV *sv
+ IV nlen
+ SV *insv
+ PREINIT:
+ STRLEN slen;
+ const char *str;
+ PPCODE:
+ str = SvPV_const(insv, slen);
+ XPUSHs(sv);
+ mXPUSHi(SvLEN(sv));
+ SvPV_renew(sv, nlen);
+ Copy(str, SvPVX(sv), slen + 1, char);
+ SvCUR_set(sv, slen);
+ mXPUSHi(SvLEN(sv));
+

-=tests plan => 39
+=tests plan => 47

my $mhx = "mhx";

@@ -487,3 +509,16 @@
$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);

+my $str = "";
+my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80);
+ok($str, "x"x80);
+ok($s2, "x"x80);
+ok($before < 81);
+ok($after, 81);
+
+$str = "x"x400;
+($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40);
+ok($str, "x"x40);
+ok($s2, "x"x40);
+ok($before > 41);
+ok($after, 41);

==== //depot/perl/ext/Devel/PPPort/parts/inc/newCONSTSUB#8 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/newCONSTSUB
--- perl/ext/Devel/PPPort/parts/inc/newCONSTSUB#7~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/inc/newCONSTSUB 2008-10-12 13:23:51.000000000 -0700
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 13 $
+## $Revision: 14 $
## $Author: mhx $
-## $Date: 2008/01/04 10:47:43 +0100 $
+## $Date: 2008/10/12 19:02:04 +0200 $
##
################################################################################
##
@@ -30,6 +30,10 @@
#if { VERSION < 5.004_63 } && { VERSION != 5.004_05 }
#if { NEED newCONSTSUB }

+/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
+/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
+#define D_PPP_PL_copline PL_copline
+
void
newCONSTSUB(HV *stash, const char *name, SV *sv)
{
@@ -37,7 +41,7 @@
HV *old_cop_stash = PL_curcop->cop_stash;
HV *old_curstash = PL_curstash;
line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = PL_copline;
+ PL_curcop->cop_line = D_PPP_PL_copline;

PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)

==== //depot/perl/ext/Devel/PPPort/parts/inc/ppphbin#15 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/ppphbin
--- perl/ext/Devel/PPPort/parts/inc/ppphbin#14~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/inc/ppphbin 2008-10-12 13:23:51.000000000 -0700
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 47 $
+## $Revision: 48 $
## $Author: mhx $
-## $Date: 2008/01/04 12:03:30 +0100 $
+## $Date: 2008/10/12 19:02:39 +0200 $
##
################################################################################
##
@@ -169,8 +169,12 @@
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:$[^)]*$)?\s+(\w+).*$rccs\s+Replace\s+$rcce};
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};

- if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
- push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
+ if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
+ my @deps = map { s/\s+//g; $_ } split /,/, $3;
+ my $d;
+ for $d (map { s/\s+//g; $_ } split /,/, $1) {
+ push @{$depends{$d}}, @deps;
+ }
}

$need{$1} = 1 if m{^#if\s+defined$NEED_(\w+)(?:_GLOBAL)?$};

==== //depot/perl/ext/Devel/PPPort/parts/inc/ppphtest#18 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/ppphtest
--- perl/ext/Devel/PPPort/parts/inc/ppphtest#17~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/inc/ppphtest 2008-10-12 13:23:51.000000000 -0700
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 42 $
+## $Revision: 44 $
## $Author: mhx $
-## $Date: 2008/01/04 10:47:42 +0100 $
+## $Date: 2008/10/12 20:53:51 +0200 $
##
################################################################################
##
@@ -15,11 +15,11 @@
##
################################################################################

-=tests plan => 229
+=tests plan => 235

BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 229) {
+ for (1 .. 235) {
skip("skip: SKIP_SLOW_TESTS", 0);
}
exit 0;
@@ -276,9 +276,11 @@
ok($o =~ /Analyzing.*file1\.xs/mi);
ok($o !~ /^Scanning.*file2\.xs/mi);
ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses PL_expect/m);
ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m);
ok($o =~ /WARNING: PL_expect/m);
ok($o =~ /hint for newCONSTSUB/m);
+ok($o =~ /^Analysis completed $1 warning$/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --nohints file1.xs));
@@ -286,9 +288,11 @@
ok($o =~ /Analyzing.*file1\.xs/mi);
ok($o !~ /^Scanning.*file2\.xs/mi);
ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses PL_expect/m);
ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m);
ok($o =~ /WARNING: PL_expect/m);
ok($o !~ /hint for newCONSTSUB/m);
+ok($o =~ /^Analysis completed $1 warning$/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
@@ -296,9 +300,11 @@
ok($o =~ /Analyzing.*file1\.xs/mi);
ok($o !~ /^Scanning.*file2\.xs/mi);
ok($o !~ /^Uses newCONSTSUB/m);
+ok($o !~ /^Uses PL_expect/m);
ok($o !~ /^Uses SvPV_nolen/m);
ok($o =~ /WARNING: PL_expect/m);
ok($o !~ /hint for newCONSTSUB/m);
+ok($o =~ /^Analysis completed $1 warning$/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --quiet file1.xs));
@@ -338,6 +344,7 @@

#define NEED_newCONSTSUB
#define NEED_sv_2pv_flags
+#define NEED_PL_parser
#include "ppport.h"

newCONSTSUB();
@@ -808,6 +815,7 @@

---------------------------- file.xs -----------------------------------------

+#define NEED_PL_parser
#include "ppport.h"
SvUOK
PL_copline

==== //depot/perl/ext/Devel/PPPort/parts/inc/snprintf#4 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/snprintf
--- perl/ext/Devel/PPPort/parts/inc/snprintf#3~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/inc/snprintf 2008-10-12 13:23:51.000000000 -0700
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 4 $
+## $Revision: 5 $
## $Author: mhx $
-## $Date: 2008/01/04 14:54:43 +0100 $
+## $Date: 2008/08/01 23:26:01 +0200 $
##
################################################################################
##
@@ -37,7 +37,7 @@
retval = vsprintf(buffer, format, ap);
#endif
va_end(ap);
- if (retval >= (int)len)
+ if (retval < 0 || (len > 0 && (Size_t)retval >= len))
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
return retval;
}

==== //depot/perl/ext/Devel/PPPort/parts/inc/sprintf#1 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/sprintf
--- /dev/null 2008-09-17 12:36:34.330355001 -0700
+++ perl/ext/Devel/PPPort/parts/inc/sprintf 2008-10-12 13:23:51.000000000 -0700
@@ -0,0 +1,62 @@
+################################################################################
+##
+## $Revision: 1 $
+## $Author: mhx $
+## $Date: 2008/07/13 19:13:58 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004-2008, 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
+
+my_sprintf
+
+=implementation
+
+#if !defined(my_sprintf)
+#if { NEED my_sprintf }
+
+int
+my_sprintf(char *buffer, const char* pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ vsprintf(buffer, pat, args);
+ va_end(args);
+ return strlen(buffer);
+}
+
+#endif
+#endif
+
+=xsinit
+
+#define NEED_my_sprintf
+
+=xsubs
+
+void
+my_sprintf()
+ PREINIT:
+ char buf[128];
+ int len;
+ PPCODE:
+ len = my_sprintf(buf, "foo%s%d", "bar", 42);
+ mXPUSHi(len);
+ mXPUSHs(newSVpv(buf, 0));
+ XSRETURN(2);
+
+=tests plan => 2
+
+my($l, $s) = Devel::PPPort::my_sprintf();
+ok($l, 8);
+ok($s, "foobar42");
+

==== //depot/perl/ext/Devel/PPPort/parts/inc/variables#12 (text) ====
Index: perl/ext/Devel/PPPort/parts/inc/variables
--- perl/ext/Devel/PPPort/parts/inc/variables#11~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/inc/variables 2008-10-12 13:23:51.000000000 -0700
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 15 $
+## $Revision: 17 $
## $Author: mhx $
-## $Date: 2008/01/04 14:54:44 +0100 $
+## $Date: 2008/10/12 20:53:47 +0200 $
##
################################################################################
##
@@ -24,6 +24,8 @@
PL_DBsub
PL_DBtrace
PL_Sv
+PL_bufend
+PL_bufptr
PL_compiling
PL_copline
PL_curcop
@@ -38,7 +40,11 @@
PL_hexdigit
PL_hints
PL_laststatval
+PL_lex_state
+PL_lex_stuff
+PL_linestr
PL_na
+PL_parser
PL_perl_destruct_level
PL_perldb
PL_rsfp_filters
@@ -53,13 +59,10 @@
PL_sv_yes
PL_tainted
PL_tainting
+PL_tokenbuf
PL_signals
PERL_SIGNALS_UNSAFE_FLAG

-=dontwarn
-
-D_PPP_PERL_SIGNALS_INIT
-
=implementation

#ifndef PERL_SIGNALS_UNSAFE_FLAG
@@ -97,6 +100,8 @@
# define PL_DBsub DBsub
# define PL_DBtrace DBtrace
# define PL_Sv Sv
+# define PL_bufend bufend
+# define PL_bufptr bufptr
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
@@ -111,6 +116,9 @@
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_laststatval laststatval
+# define PL_lex_state lex_state
+# define PL_lex_stuff lex_stuff
+# define PL_linestr linestr
# define PL_na na
# define PL_perl_destruct_level perl_destruct_level
# define PL_perldb perldb
@@ -126,26 +134,75 @@
# define PL_sv_yes sv_yes
# define PL_tainted tainted
# define PL_tainting tainting
+# define PL_tokenbuf tokenbuf
/* Replace: 0 */
#endif

-/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters
- * Do not use this variable. It is internal to the perl parser
- * and may change or even be removed in the future. Note that
- * as of perl 5.9.5 you cannot assign to this variable anymore.
+/* Warning: PL_parser
+ * For perl versions earlier than 5.9.5, this is an always
+ * non-NULL dummy. Also, it cannot be dereferenced. Don't
+ * use it if you can avoid is and unless you absolutely know
+ * what you're doing.
+ * If you always check that PL_parser is non-NULL, you can
+ * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
+ * a dummy parser structure.
*/

-/* TODO: cannot assign to these vars; is it worth fixing? */
#if { VERSION >= 5.9.5 }
-# define PL_expect (PL_parser ? PL_parser->expect : 0)
-# define PL_copline (PL_parser ? PL_parser->copline : 0)
-# define PL_rsfp (PL_parser ? PL_parser->rsfp : (PerlIO *) 0)
-# define PL_rsfp_filters (PL_parser ? PL_parser->rsfp_filters : (AV *) 0)
+# ifdef DPPP_PL_parser_NO_DUMMY
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (croak("panic: PL_parser == NULL in %s:%d", \
+ __FILE__, __LINE__), (yy_parser *) NULL))->var)
+# else
+# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
+# define D_PPP_parser_dummy_warning(var)
+# else
+# define D_PPP_parser_dummy_warning(var) \
+ warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
+# endif
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
+__NEED_DUMMY_VAR__ yy_parser PL_parser;
+# endif
+
+/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
+/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
+ * Do not use this variable unless you know exactly what you're
+ * doint. It is internal to the perl parser and may change or even
+ * be removed in the future. As of perl 5.9.5, you have to check
+ * for (PL_parser != NULL) for this variable to have any effect.
+ * An always non-NULL PL_parser dummy is provided for earlier
+ * perl versions.
+ * If PL_parser is NULL when you try to access this variable, a
+ * dummy is being accessed instead and a warning is issued unless
+ * you define DPPP_PL_parser_NO_DUMMY_WARNING.
+ * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
+ * this variable will croak with a panic message.
+ */
+
+# define PL_expect D_PPP_my_PL_parser_var(expect)
+# define PL_copline D_PPP_my_PL_parser_var(copline)
+# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
+# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
+# define PL_linestr D_PPP_my_PL_parser_var(linestr)
+# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
+# define PL_bufend D_PPP_my_PL_parser_var(bufend)
+# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
+# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
+# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
+
+#else
+
+/* ensure that PL_parser != NULL and cannot be dereferenced */
+# define PL_parser ((void *) 1)
+
#endif

=xsinit

#define NEED_PL_signals
+#define NEED_PL_parser
+#define DPPP_PL_parser_NO_DUMMY_WARNING

=xsmisc

@@ -156,8 +213,35 @@

extern U32 get_PL_signals_2(void);
extern U32 get_PL_signals_3(void);
+int no_dummy_parser_vars(int);
+int dummy_parser_warning(void);

-#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END
+#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END
+
+#define ppp_PARSERVAR(type, var) STMT_START { \
+ type volatile my_ ## var; \
+ type volatile *my_p_ ## var; \
+ my_ ## var = var; \
+ my_p_ ## var = &var; \
+ var = my_ ## var; \
+ var = *my_p_ ## var; \
+ mXPUSHi(&var != NULL); \
+ count++; \
+ } STMT_END
+
+#if PERL_BCDVERSION < 0x5006000
+# define ppp_expect_t expectation
+#elif PERL_BCDVERSION < 0x5009005
+# define ppp_expect_t int
+#else
+# define ppp_expect_t U8
+#endif
+
+#if PERL_BCDVERSION < 0x5009005
+# define ppp_lex_state_t U32
+#else
+# define ppp_lex_state_t U8
+#endif

=xsubs

@@ -210,30 +294,28 @@
RETVAL

SV *
-PL_copline()
- CODE:
- RETVAL = newSViv((IV) PL_copline);
- OUTPUT:
- RETVAL
-
-SV *
-PL_expect()
+PL_rsfp()
+ PREINIT:
+ void * volatile my_rsfp;
+ /* no pointer test, as we don't know the exact type */
CODE:
- RETVAL = newSViv((IV) PL_expect);
+ my_rsfp = PL_rsfp;
+ RETVAL = newSViv(PL_rsfp != 0);
+ PL_rsfp = my_rsfp;
OUTPUT:
RETVAL

SV *
-PL_rsfp()
+PL_tokenbuf()
CODE:
- RETVAL = newSViv(PL_rsfp != 0);
+ RETVAL = newSViv(PL_tokenbuf[0]);
OUTPUT:
RETVAL

SV *
-PL_rsfp_filters()
+PL_parser()
CODE:
- RETVAL = newSViv(PL_rsfp_filters != 0);
+ RETVAL = newSViv(PL_parser != NULL);
OUTPUT:
RETVAL

@@ -293,9 +375,26 @@
ppp_TESTVAR(PL_sv_arenaroot);
ppp_TESTVAR(PL_tainted);
ppp_TESTVAR(PL_tainting);
+
+ ppp_PARSERVAR(ppp_expect_t, PL_expect);
+ ppp_PARSERVAR(line_t, PL_copline);
+ ppp_PARSERVAR(AV *, PL_rsfp_filters);
+ ppp_PARSERVAR(SV *, PL_linestr);
+ ppp_PARSERVAR(char *, PL_bufptr);
+ ppp_PARSERVAR(char *, PL_bufend);
+ ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state);
+ ppp_PARSERVAR(SV *, PL_lex_stuff);
+
XSRETURN(count);

-=tests plan => 37
+int
+no_dummy_parser_vars(check)
+ int check
+
+int
+dummy_parser_warning()
+
+=tests plan => 49

ok(Devel::PPPort::compare_PL_signals());

@@ -304,10 +403,9 @@
ok(!&Devel::PPPort::PL_sv_no());
ok(&Devel::PPPort::PL_na("abcd"), 4);
ok(&Devel::PPPort::PL_Sv(), "mhx");
-ok(defined &Devel::PPPort::PL_copline());
-ok(defined &Devel::PPPort::PL_expect());
ok(defined &Devel::PPPort::PL_rsfp());
-ok(defined &Devel::PPPort::PL_rsfp_filters());
+ok(defined &Devel::PPPort::PL_tokenbuf());
+ok($] >= 5.009005 || &Devel::PPPort::PL_parser());
ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
ok(defined &Devel::PPPort::PL_hints());
ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
@@ -315,3 +413,43 @@
for (&Devel::PPPort::other_variables()) {
ok($_ != 0);
}
+
+{
+ my @w;
+ my $fail = 0;
+ {
+ local $SIG{'__WARN__'} = sub { push @w, @_ };
+ ok(&Devel::PPPort::dummy_parser_warning());
+ }
+ if ($] >= 5.009005) {
+ ok(@w >= 0);
+ for (@w) {
+ print "# $_";
+ unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
+ warn $_;
+ $fail++;
+ }
+ }
+ }
+ else {
+ ok(@w == 0);
+ }
+ ok($fail, 0);
+}
+
+ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0));
+
+eval { &Devel::PPPort::no_dummy_parser_vars(0) };
+
+if ($] < 5.009005) {
+ ok($@, '');
+}
+else {
+ if ($@) {
+ print "# $@";
+ ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);
+ }
+ else {
+ ok(1);
+ }
+}

==== //depot/perl/ext/Devel/PPPort/parts/ppptools.pl#15 (text) ====
Index: perl/ext/Devel/PPPort/parts/ppptools.pl
--- perl/ext/Devel/PPPort/parts/ppptools.pl#14~34130~ 2008-07-11 13:55:01.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/ppptools.pl 2008-10-12 13:23:51.000000000 -0700
@@ -4,9 +4,9 @@
#
################################################################################
#
-# $Revision: 25 $
+# $Revision: 26 $
# $Author: mhx $
-# $Date: 2008/07/11 22:38:15 +0200 $
+# $Date: 2008/10/12 19:03:01 +0200 $
#
################################################################################
#
@@ -188,6 +188,7 @@
my($nop) = /^Perl_(.*)/;
not exists $prov{$_} ||
exists $dontwarn{$_} ||
+ /^D_PPP_/ ||
(defined $nop && exists $prov{$nop} ) ||
(defined $nop && exists $dontwarn{$nop}) ||
$h{$_}++;

==== //depot/perl/ext/Devel/PPPort/parts/todo/5009003#6 (text) ====
Index: perl/ext/Devel/PPPort/parts/todo/5009003
--- perl/ext/Devel/PPPort/parts/todo/5009003#5~32827~ 2008-01-04 06:10:18.000000000 -0800
+++ perl/ext/Devel/PPPort/parts/todo/5009003 2008-10-12 13:23:51.000000000 -0700
@@ -16,7 +16,6 @@
hv_riter_p # U
hv_riter_set # U
is_utf8_string_loclen # U
-my_sprintf # U
newGIVENOP # U
newSVhek # U
newSVpvs_share # U

==== //depot/perl/ext/Devel/PPPort/soak#35 (text) ====
Index: perl/ext/Devel/PPPort/soak
--- perl/ext/Devel/PPPort/soak#34~34130~ 2008-07-11 13:55:01.000000000 -0700
+++ perl/ext/Devel/PPPort/soak 2008-10-12 13:23:51.000000000 -0700
@@ -33,7 +33,7 @@
use List::Util qw(max);
use Config;

-my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };

$| = 1;
my %OPT = (

==== //depot/perl/ext/Devel/PPPort/t/SvPV.t#9 (text) ====
Index: perl/ext/Devel/PPPort/t/SvPV.t
--- perl/ext/Devel/PPPort/t/SvPV.t#8~33824~ 2008-05-13 12:50:23.000000000 -0700
+++ perl/ext/Devel/PPPort/t/SvPV.t 2008-10-12 13:23:51.000000000 -0700
@@ -30,9 +30,9 @@
require 'testutil.pl' if $@;
}

- if (39) {
+ if (47) {
load();
- plan(tests => 39);
+ plan(tests => 47);
}
}

@@ -100,3 +100,17 @@
$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);

+my $str = "";
+my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80);
+ok($str, "x"x80);
+ok($s2, "x"x80);
+ok($before < 81);
+ok($after, 81);
+
+$str = "x"x400;
+($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40);
+ok($str, "x"x40);
+ok($s2, "x"x40);
+ok($before > 41);
+ok($after, 41);
+

==== //depot/perl/ext/Devel/PPPort/t/ppphtest.t#18 (text) ====
Index: perl/ext/Devel/PPPort/t/ppphtest.t
--- perl/ext/Devel/PPPort/t/ppphtest.t#17~31848~ 2007-09-11 14:45:40.000000000 -0700
+++ perl/ext/Devel/PPPort/t/ppphtest.t 2008-10-12 13:23:51.000000000 -0700
@@ -30,9 +30,9 @@
require 'testutil.pl' if $@;
}

- if (229) {
+ if (235) {
load();
- plan(tests => 229);
+ plan(tests => 235);
}
}

@@ -50,7 +50,7 @@

BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 229) {
+ for (1 .. 235) {
skip("skip: SKIP_SLOW_TESTS", 0);
}
exit 0;
@@ -307,9 +307,11 @@
ok($o =~ /Analyzing.*file1\.xs/mi);
ok($o !~ /^Scanning.*file2\.xs/mi);
ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses PL_expect/m);
ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m);
ok($o =~ /WARNING: PL_expect/m);
ok($o =~ /hint for newCONSTSUB/m);
+ok($o =~ /^Analysis completed $1 warning$/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --nohints file1.xs));
@@ -317,9 +319,11 @@
ok($o =~ /Analyzing.*file1\.xs/mi);
ok($o !~ /^Scanning.*file2\.xs/mi);
ok($o =~ /^Uses newCONSTSUB/m);
+ok($o =~ /^Uses PL_expect/m);
ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m);
ok($o =~ /WARNING: PL_expect/m);
ok($o !~ /hint for newCONSTSUB/m);
+ok($o =~ /^Analysis completed $1 warning$/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
@@ -327,9 +331,11 @@
ok($o =~ /Analyzing.*file1\.xs/mi);
ok($o !~ /^Scanning.*file2\.xs/mi);
ok($o !~ /^Uses newCONSTSUB/m);
+ok($o !~ /^Uses PL_expect/m);
ok($o !~ /^Uses SvPV_nolen/m);
ok($o =~ /WARNING: PL_expect/m);
ok($o !~ /hint for newCONSTSUB/m);
+ok($o =~ /^Analysis completed $1 warning$/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --quiet file1.xs));
@@ -369,6 +375,7 @@

#define NEED_newCONSTSUB
#define NEED_sv_2pv_flags
+#define NEED_PL_parser
#include "ppport.h"

newCONSTSUB();
@@ -839,6 +846,7 @@

---------------------------- file.xs -----------------------------------------

+#define NEED_PL_parser
#include "ppport.h"
SvUOK
PL_copline

==== //depot/perl/ext/Devel/PPPort/t/sprintf.t#1 (text) ====
Index: perl/ext/Devel/PPPort/t/sprintf.t
--- /dev/null 2008-09-17 12:36:34.330355001 -0700
+++ perl/ext/Devel/PPPort/t/sprintf.t 2008-10-12 13:23:51.000000000 -0700
@@ -0,0 +1,54 @@
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/sprintf 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 (2) {
+ load();
+ plan(tests => 2);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+package Devel::PPPort;
+use vars '@ISA';
+require DynaLoader;
+@ISA = qw(DynaLoader);
+bootstrap Devel::PPPort;
+
+package main;
+
+my($l, $s) = Devel::PPPort::my_sprintf();
+ok($l, 8);
+ok($s, "foobar42");
+

==== //depot/perl/ext/Devel/PPPort/t/variables.t#7 (text) ====
Index: perl/ext/Devel/PPPort/t/variables.t
--- perl/ext/Devel/PPPort/t/variables.t#6~31705~ 2007-08-12 16:17:42.000000000 -0700
+++ perl/ext/Devel/PPPort/t/variables.t 2008-10-12 13:23:51.000000000 -0700
@@ -30,9 +30,9 @@
require 'testutil.pl' if $@;
}

- if (37) {
+ if (49) {
load();
- plan(tests => 37);
+ plan(tests => 49);
}
}

@@ -55,10 +55,9 @@
ok(!&Devel::PPPort::PL_sv_no());
ok(&Devel::PPPort::PL_na("abcd"), 4);
ok(&Devel::PPPort::PL_Sv(), "mhx");
-ok(defined &Devel::PPPort::PL_copline());
-ok(defined &Devel::PPPort::PL_expect());
ok(defined &Devel::PPPort::PL_rsfp());
-ok(defined &Devel::PPPort::PL_rsfp_filters());
+ok(defined &Devel::PPPort::PL_tokenbuf());
+ok($] >= 5.009005 || &Devel::PPPort::PL_parser());
ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
ok(defined &Devel::PPPort::PL_hints());
ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
@@ -67,3 +66,43 @@
ok($_ != 0);
}

+{
+ my @w;
+ my $fail = 0;
+ {
+ local $SIG{'__WARN__'} = sub { push @w, @_ };
+ ok(&Devel::PPPort::dummy_parser_warning());
+ }
+ if ($] >= 5.009005) {
+ ok(@w >= 0);
+ for (@w) {
+ print "# $_";
+ unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) {
+ warn $_;
+ $fail++;
+ }
+ }
+ }
+ else {
+ ok(@w == 0);
+ }
+ ok($fail, 0);
+}
+
+ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0));
+
+eval { &Devel::PPPort::no_dummy_parser_vars(0) };
+
+if ($] < 5.009005) {
+ ok($@, '');
+}
+else {
+ if ($@) {
+ print "# $@";
+ ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i);
+ }
+ else {
+ ok(1);
+ }
+}
+
End of Patch.