Upgrade to Devel::PPPort 3.14_02

p4raw-id: //depot/perl@34475

20 files changed, 525 insertions, 80 deletions

diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes
index 5d6ef77ba0..eff58a4c61 100755
--- a/ext/Devel/PPPort/Changes
+++ b/ext/Devel/PPPort/Changes
@@ -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
diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL
index da741d74e0..68c9b97b34 100644
--- a/ext/Devel/PPPort/PPPort_pm.PL
+++ b/ext/Devel/PPPort/PPPort_pm.PL
@@ -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 @@ sub expand
               )
             \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 @@ sub expand_need_var
   $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 @@ ENDCODE
   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 @@ __DATA__
 #
 ################################################################################
 #
-#  $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 @@ package Devel::PPPort;
 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 @@ __DATA__
 
 %include snprintf
 
+%include sprintf
+
 %include exception
 
 %include strlfuncs
diff --git a/ext/Devel/PPPort/TODO b/ext/Devel/PPPort/TODO
index ce07d8a788..961acd918c 100644
--- a/ext/Devel/PPPort/TODO
+++ b/ext/Devel/PPPort/TODO
@@ -321,8 +321,6 @@ TODO:
 
 * 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:
diff --git a/ext/Devel/PPPort/module2.c b/ext/Devel/PPPort/module2.c
index bb2d19af98..a0073935dc 100644
--- a/ext/Devel/PPPort/module2.c
+++ b/ext/Devel/PPPort/module2.c
@@ -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 @@ U32 get_PL_signals_2(void)
 {
   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;
+}
diff --git a/ext/Devel/PPPort/module3.c b/ext/Devel/PPPort/module3.c
index 6926351855..50ea2deca2 100644
--- a/ext/Devel/PPPort/module3.c
+++ b/ext/Devel/PPPort/module3.c
@@ -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 @@ U32 get_PL_signals_3(void)
 {
   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;
+}
diff --git a/ext/Devel/PPPort/parts/apicheck.pl b/ext/Devel/PPPort/parts/apicheck.pl
index 2bb73b8a4e..dedc41a637 100644
--- a/ext/Devel/PPPort/parts/apicheck.pl
+++ b/ext/Devel/PPPort/parts/apicheck.pl
@@ -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 @@ print OUT <<HEAD;
 #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 @@ print OUT <<HEAD;
 #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
diff --git a/ext/Devel/PPPort/parts/inc/SvPV b/ext/Devel/PPPort/parts/inc/SvPV
index 0db89ddafc..8adc20f769 100644
--- a/ext/Devel/PPPort/parts/inc/SvPV
+++ b/ext/Devel/PPPort/parts/inc/SvPV
@@ -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(sv, lp) SvPV_flags(sv, lp, 0)
 __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 @@ SvPV_nomg_const_nolen(sv)
 	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($mhx), 2);
 $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);
diff --git a/ext/Devel/PPPort/parts/inc/newCONSTSUB b/ext/Devel/PPPort/parts/inc/newCONSTSUB
index cd01615b8f..5eda721512 100644
--- a/ext/Devel/PPPort/parts/inc/newCONSTSUB
+++ b/ext/Devel/PPPort/parts/inc/newCONSTSUB
@@ -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 @@ newCONSTSUB
 #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 @@ newCONSTSUB(HV *stash, const char *name, SV *sv)
 	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)
diff --git a/ext/Devel/PPPort/parts/inc/ppphbin b/ext/Devel/PPPort/parts/inc/ppphbin
index b474c4074f..838a4e188d 100644
--- a/ext/Devel/PPPort/parts/inc/ppphbin
+++ b/ext/Devel/PPPort/parts/inc/ppphbin
@@ -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 @@ while (<DATA>) {
   $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)?\)};
diff --git a/ext/Devel/PPPort/parts/inc/ppphtest b/ext/Devel/PPPort/parts/inc/ppphtest
index c3a7bde45a..3afec7b714 100644
--- a/ext/Devel/PPPort/parts/inc/ppphtest
+++ b/ext/Devel/PPPort/parts/inc/ppphtest
@@ -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 =~ /^Scanning.*file1\.xs/mi);
 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 =~ /^Scanning.*file1\.xs/mi);
 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 =~ /^Scanning.*file1\.xs/mi);
 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 @@ ok($o =~ /^\s*$/);
 
 #define NEED_newCONSTSUB
 #define NEED_sv_2pv_flags
+#define NEED_PL_parser
 #include "ppport.h"
 
 newCONSTSUB();
@@ -808,6 +815,7 @@ ok($o =~ /^Looks good/m);
 
 ---------------------------- file.xs -----------------------------------------
 
+#define NEED_PL_parser
 #include "ppport.h"
 SvUOK
 PL_copline
diff --git a/ext/Devel/PPPort/parts/inc/snprintf b/ext/Devel/PPPort/parts/inc/snprintf
index 84374aeb1b..9c923108ca 100644
--- a/ext/Devel/PPPort/parts/inc/snprintf
+++ b/ext/Devel/PPPort/parts/inc/snprintf
@@ -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 @@ my_snprintf(char *buffer, const Size_t len, const char *format, ...)
     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;
 }
diff --git a/ext/Devel/PPPort/parts/inc/sprintf b/ext/Devel/PPPort/parts/inc/sprintf
new file mode 100644
index 0000000000..bb9617f3e2
--- /dev/null
+++ b/ext/Devel/PPPort/parts/inc/sprintf
@@ -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");
+
diff --git a/ext/Devel/PPPort/parts/inc/variables b/ext/Devel/PPPort/parts/inc/variables
index e3819088fa..c5a3f489b5 100644
--- a/ext/Devel/PPPort/parts/inc/variables
+++ b/ext/Devel/PPPort/parts/inc/variables
@@ -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_DBsingle
 PL_DBsub
 PL_DBtrace
 PL_Sv
+PL_bufend
+PL_bufptr
 PL_compiling
 PL_copline
 PL_curcop
@@ -38,7 +40,11 @@ PL_expect
 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_undef
 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 @@ __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
 #  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 @@ __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
 #  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 @@ __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
 #  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 @@ U32 get_PL_signals_1(void)
 
 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_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
 
-#define ppp_TESTVAR(var)   STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END
+#if PERL_BCDVERSION < 0x5009005
+# define ppp_lex_state_t U32
+#else
+# define ppp_lex_state_t U8
+#endif
 
 =xsubs
 
@@ -210,30 +294,28 @@ PL_Sv()
 		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 @@ other_variables()
 		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_yes());
 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 @@ ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
 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);
+  }
+}
diff --git a/ext/Devel/PPPort/parts/ppptools.pl b/ext/Devel/PPPort/parts/ppptools.pl
index e01009c0e8..b81c8aa2a8 100644
--- a/ext/Devel/PPPort/parts/ppptools.pl
+++ b/ext/Devel/PPPort/parts/ppptools.pl
@@ -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 @@ sub parse_partspec
                          my($nop) = /^Perl_(.*)/;
                          not exists $prov{$_}                         ||
                              exists $dontwarn{$_}                     ||
+                             /^D_PPP_/                                ||
                              (defined $nop && exists $prov{$nop}    ) ||
                              (defined $nop && exists $dontwarn{$nop}) ||
                              $h{$_}++;
diff --git a/ext/Devel/PPPort/parts/todo/5009003 b/ext/Devel/PPPort/parts/todo/5009003
index 86e728675a..7be9e0749e 100644
--- a/ext/Devel/PPPort/parts/todo/5009003
+++ b/ext/Devel/PPPort/parts/todo/5009003
@@ -16,7 +16,6 @@ hv_placeholders_set            # U
 hv_riter_p                     # U
 hv_riter_set                   # U
 is_utf8_string_loclen          # U
-my_sprintf                     # U
 newGIVENOP                     # U
 newSVhek                       # U
 newSVpvs_share                 # U
diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak
index 546430fdb5..7e5a66b77b 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.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 = (
diff --git a/ext/Devel/PPPort/t/SvPV.t b/ext/Devel/PPPort/t/SvPV.t
index d00327ebe5..cd1a3e1f4f 100644
--- a/ext/Devel/PPPort/t/SvPV.t
+++ b/ext/Devel/PPPort/t/SvPV.t
@@ -30,9 +30,9 @@ BEGIN {
     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($mhx), 2);
 $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);
+
diff --git a/ext/Devel/PPPort/t/ppphtest.t b/ext/Devel/PPPort/t/ppphtest.t
index 56f83b3e3f..36dcc0ccea 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 (229) {
+  if (235) {
     load();
-    plan(tests => 229);
+    plan(tests => 235);
   }
 }
 
@@ -50,7 +50,7 @@ package main;
 
 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 =~ /^Scanning.*file1\.xs/mi);
 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 =~ /^Scanning.*file1\.xs/mi);
 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 =~ /^Scanning.*file1\.xs/mi);
 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 @@ ok($o =~ /^\s*$/);
 
 #define NEED_newCONSTSUB
 #define NEED_sv_2pv_flags
+#define NEED_PL_parser
 #include "ppport.h"
 
 newCONSTSUB();
@@ -839,6 +846,7 @@ ok($o =~ /^Looks good/m);
 
 ---------------------------- file.xs -----------------------------------------
 
+#define NEED_PL_parser
 #include "ppport.h"
 SvUOK
 PL_copline
diff --git a/ext/Devel/PPPort/t/sprintf.t b/ext/Devel/PPPort/t/sprintf.t
new file mode 100644
index 0000000000..5e3f3124d8
--- /dev/null
+++ b/ext/Devel/PPPort/t/sprintf.t
@@ -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");
+
diff --git a/ext/Devel/PPPort/t/variables.t b/ext/Devel/PPPort/t/variables.t
index 83444a7061..0e3a30c220 100644
--- a/ext/Devel/PPPort/t/variables.t
+++ b/ext/Devel/PPPort/t/variables.t
@@ -30,9 +30,9 @@ BEGIN {
     require 'testutil.pl' if $@;
   }
 
-  if (37) {
+  if (49) {
     load();
-    plan(tests => 37);
+    plan(tests => 49);
   }
 }
 
@@ -55,10 +55,9 @@ ok(&Devel::PPPort::PL_sv_yes());
 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 @@ 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);
+  }
+}
+