From: Marcus Holland-Moritz Date: Sun, 12 Oct 2008 20:23:51 +0000 (+0000) Subject: Upgrade to Devel::PPPort 3.14_02 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c01be2ceee59c12c021a43356af939d6df88f074;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Devel::PPPort 3.14_02 p4raw-id: //depot/perl@34475 --- diff --git a/MANIFEST b/MANIFEST index b78f137..63592e2 100644 --- a/MANIFEST +++ b/MANIFEST @@ -282,6 +282,7 @@ 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/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/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/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 diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes index 5d6ef77..eff58a4 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 da741d7..68c9b97 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 = <= 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 bb2d19a..a007393 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 6926351..50ea2de 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 2bb73b8..dedc41a 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 < 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 cd01615..5eda721 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 b474c40..838a4e1 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 () { $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 c3a7bde..3afec7b 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 84374ae..9c92310 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 0000000..bb9617f --- /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 e381908..c5a3f48 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 e01009c..b81c8aa 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 86e7286..7be9e07 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 546430f..7e5a66b 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 d00327e..cd1a3e1 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 56f83b3..36dcc0c 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 0000000..5e3f312 --- /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 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 83444a7..0e3a30c 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); + } +} +