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
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
+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
#
################################################################################
#
-# $Revision: 59 $
+# $Revision: 61 $
# $Author: mhx $
-# $Date: 2008/01/04 10:47:38 +0100 $
+# $Date: 2008/10/12 13:54:21 +0200 $
#
################################################################################
#
)
\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;
}
$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
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) = @_;
#
################################################################################
#
-# $Revision: 59 $
+# $Revision: 61 $
# $Author: mhx $
-# $Date: 2008/01/04 10:47:38 +0100 $
+# $Date: 2008/10/12 13:54:21 +0200 $
#
################################################################################
#
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
{
%include snprintf
+%include sprintf
+
%include exception
%include strlfuncs
* 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:
*
********************************************************************************
*
-* $Revision: 10 $
+* $Revision: 11 $
* $Author: mhx $
-* $Date: 2008/01/04 10:47:38 +0100 $
+* $Date: 2008/10/12 20:53:51 +0200 $
*
********************************************************************************
*
#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)
{
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;
+}
*
********************************************************************************
*
-* $Revision: 10 $
+* $Revision: 11 $
* $Author: mhx $
-* $Date: 2008/01/04 10:47:38 +0100 $
+* $Date: 2008/10/12 20:53:51 +0200 $
*
********************************************************************************
*
#include "EXTERN.h"
#include "perl.h"
+#define NEED_PL_parser
#define NO_XSLOCKS
#include "XSUB.h"
{
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;
+}
#
################################################################################
#
-# $Revision: 29 $
+# $Revision: 32 $
# $Author: mhx $
-# $Date: 2008/01/04 12:02:22 +0100 $
+# $Date: 2008/10/12 20:50:38 +0200 $
#
################################################################################
#
#else
#define NEED_PL_signals
+#define NEED_PL_parser
#define NEED_eval_pv
#define NEED_grok_bin
#define NEED_grok_hex
#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
################################################################################
##
-## $Revision: 20 $
+## $Revision: 21 $
## $Author: mhx $
-## $Date: 2008/05/13 21:05:51 +0200 $
+## $Date: 2008/10/12 20:51:06 +0200 $
##
################################################################################
##
__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
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";
$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);
################################################################################
##
-## $Revision: 13 $
+## $Revision: 14 $
## $Author: mhx $
-## $Date: 2008/01/04 10:47:43 +0100 $
+## $Date: 2008/10/12 19:02:04 +0200 $
##
################################################################################
##
#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)
{
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)
################################################################################
##
-## $Revision: 47 $
+## $Revision: 48 $
## $Author: mhx $
-## $Date: 2008/01/04 12:03:30 +0100 $
+## $Date: 2008/10/12 19:02:39 +0200 $
##
################################################################################
##
$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)?\)};
################################################################################
##
-## $Revision: 42 $
+## $Revision: 44 $
## $Author: mhx $
-## $Date: 2008/01/04 10:47:42 +0100 $
+## $Date: 2008/10/12 20:53:51 +0200 $
##
################################################################################
##
##
################################################################################
-=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;
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));
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));
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));
#define NEED_newCONSTSUB
#define NEED_sv_2pv_flags
+#define NEED_PL_parser
#include "ppport.h"
newCONSTSUB();
---------------------------- file.xs -----------------------------------------
+#define NEED_PL_parser
#include "ppport.h"
SvUOK
PL_copline
################################################################################
##
-## $Revision: 4 $
+## $Revision: 5 $
## $Author: mhx $
-## $Date: 2008/01/04 14:54:43 +0100 $
+## $Date: 2008/08/01 23:26:01 +0200 $
##
################################################################################
##
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;
}
--- /dev/null
+################################################################################
+##
+## $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");
+
################################################################################
##
-## $Revision: 15 $
+## $Revision: 17 $
## $Author: mhx $
-## $Date: 2008/01/04 14:54:44 +0100 $
+## $Date: 2008/10/12 20:53:47 +0200 $
##
################################################################################
##
PL_DBsub
PL_DBtrace
PL_Sv
+PL_bufend
+PL_bufptr
PL_compiling
PL_copline
PL_curcop
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
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
# 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
# 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
# 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
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
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
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());
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");
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);
+ }
+}
#
################################################################################
#
-# $Revision: 25 $
+# $Revision: 26 $
# $Author: mhx $
-# $Date: 2008/07/11 22:38:15 +0200 $
+# $Date: 2008/10/12 19:03:01 +0200 $
#
################################################################################
#
my($nop) = /^Perl_(.*)/;
not exists $prov{$_} ||
exists $dontwarn{$_} ||
+ /^D_PPP_/ ||
(defined $nop && exists $prov{$nop} ) ||
(defined $nop && exists $dontwarn{$nop}) ||
$h{$_}++;
hv_riter_p # U
hv_riter_set # U
is_utf8_string_loclen # U
-my_sprintf # U
newGIVENOP # U
newSVhek # U
newSVpvs_share # U
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 = (
require 'testutil.pl' if $@;
}
- if (39) {
+ if (47) {
load();
- plan(tests => 39);
+ plan(tests => 47);
}
}
$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);
+
require 'testutil.pl' if $@;
}
- if (229) {
+ if (235) {
load();
- plan(tests => 229);
+ plan(tests => 235);
}
}
BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 229) {
+ for (1 .. 235) {
skip("skip: SKIP_SLOW_TESTS", 0);
}
exit 0;
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));
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));
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));
#define NEED_newCONSTSUB
#define NEED_sv_2pv_flags
+#define NEED_PL_parser
#include "ppport.h"
newCONSTSUB();
---------------------------- file.xs -----------------------------------------
+#define NEED_PL_parser
#include "ppport.h"
SvUOK
PL_copline
--- /dev/null
+################################################################################
+#
+# !!!!! 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");
+
require 'testutil.pl' if $@;
}
- if (37) {
+ if (49) {
load();
- plan(tests => 37);
+ plan(tests => 49);
}
}
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");
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);
+ }
+}
+
projects / p5sagit/p5-mst-13.2.git / commitdiff