ext/Devel/PPPort/parts/inc/ppphbin Devel::PPPort include
ext/Devel/PPPort/parts/inc/ppphdoc Devel::PPPort include
ext/Devel/PPPort/parts/inc/ppphtest Devel::PPPort include
+ext/Devel/PPPort/parts/inc/sv_xpvf Devel::PPPort include
ext/Devel/PPPort/parts/inc/SvPV Devel::PPPort include
ext/Devel/PPPort/parts/inc/threads Devel::PPPort include
ext/Devel/PPPort/parts/inc/uv Devel::PPPort include
ext/Devel/PPPort/README Devel::PPPort Readme
ext/Devel/PPPort/soak Devel::PPPort Test Harness to run under various Perls
ext/Devel/PPPort/t/call.t Devel::PPPort test file
+ext/Devel/PPPort/t/cop.t Devel::PPPort test file
ext/Devel/PPPort/t/grok.t Devel::PPPort test file
ext/Devel/PPPort/t/limits.t Devel::PPPort test file
ext/Devel/PPPort/t/magic.t Devel::PPPort test file
ext/Devel/PPPort/t/newCONSTSUB.t Devel::PPPort test file
ext/Devel/PPPort/t/newRV.t Devel::PPPort test file
ext/Devel/PPPort/t/ppphtest.t Devel::PPPort test file
+ext/Devel/PPPort/t/sv_xpvf.t Devel::PPPort test file
ext/Devel/PPPort/t/SvPV.t Devel::PPPort test file
ext/Devel/PPPort/t/testutil.pl Devel::PPPort test utilities
ext/Devel/PPPort/t/threads.t Devel::PPPort test file
-ext/Devel/PPPort/t/uv.t Devel::PPPort test file
+ext/Devel/PPPort/t/uv.t Devel::PPPort test file
ext/Devel/PPPort/TODO Devel::PPPort Todo
ext/Devel/PPPort/typemap Devel::PPPort Typemap
ext/Digest/MD5/Changes Digest::MD5 extension changes
+3.00_01 - 2004-08-17
+
+ * fixed problems with $^X in t/ppphtest.t when building in
+ the core on OpenBSD
+ * fixed a "duplicate dependencies" bug that could lead to
+ global NEED_'s where static NEED_'s are sufficient
+ * added support for the following API:
+ PL_DBsingle
+ PL_DBsub
+ PL_debstash
+ PL_diehook
+ PL_errgv
+ PL_no_modify
+ PL_perl_destruct_level
+ PL_ppaddr
+ PL_stack_sp
+ PL_sv_arenaroot
+ PL_tainted
+ PL_tainting
+ PUSHu
+ sv_catpvf_mg
+ sv_catpvf_mg_nocontext
+ sv_setpvf_mg
+ sv_setpvf_mg_nocontext
+ sv_vcatpvf
+ sv_vcatpvf_mg
+ sv_vsetpvf
+ sv_vsetpvf_mg
+ vnewSVpvf
+ XPUSHu
+
3.00 - 2004-08-16
* added support for dAX and dITEMS, which got lost while
parts/inc/ppphbin
parts/inc/ppphdoc
parts/inc/ppphtest
+parts/inc/sv_xpvf
parts/inc/SvPV
parts/inc/threads
parts/inc/uv
README
soak
t/call.t
+t/cop.t
t/grok.t
t/limits.t
t/magic.t
t/newCONSTSUB.t
t/newRV.t
t/ppphtest.t
+t/sv_xpvf.t
t/SvPV.t
t/testutil.pl
t/threads.t
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Devel-PPPort
-version: 3.00
+version: 3.00_01
version_from: PPPort_pm.PL
installdirs: perl
requires:
#
################################################################################
#
-# $Revision: 28 $
+# $Revision: 30 $
# $Author: mhx $
-# $Date: 2004/08/13 12:49:22 +0200 $
+# $Date: 2004/08/17 20:01:49 +0200 $
#
################################################################################
#
PL_copline
PL_curcop
PL_curstash
+ PL_DBsingle
+ PL_DBsub
+ PL_debstash
PL_defgv
+ PL_diehook
PL_dirty
PL_dowarn
+ PL_errgv
PL_hexdigit
PL_hints
PL_na
+ PL_no_modify
+ PL_perl_destruct_level
PL_perldb
+ PL_ppaddr
PL_rsfp
PL_rsfp_filters
PL_stack_base
+ PL_stack_sp
PL_stdingv
PL_Sv
+ PL_sv_arenaroot
PL_sv_no
PL_sv_undef
PL_sv_yes
+ PL_tainted
+ PL_tainting
pMY_CXT
pMY_CXT_
Poison
PTR2UV
PTRV
PUSHmortal
+ PUSHu
SAVE_DEFSV
START_MY_CXT
sv_2pv_nolen
sv_2pvbyte
sv_2uv
sv_catpv_mg
+ sv_catpvf_mg
+ sv_catpvf_mg_nocontext
sv_catpvn_mg
sv_catpvn_nomg
sv_catsv_mg
sv_setiv_mg
sv_setnv_mg
sv_setpv_mg
+ sv_setpvf_mg
+ sv_setpvf_mg_nocontext
sv_setpvn_mg
sv_setsv_mg
sv_setsv_nomg
sv_setuv_mg
sv_usepvn_mg
sv_uv
+ sv_vcatpvf
+ sv_vcatpvf_mg
+ sv_vsetpvf
+ sv_vsetpvf_mg
SvGETMAGIC
SvIV_nomg
SvPV_force_nomg
UVuf
UVXf
UVxf
+ vnewSVpvf
XPUSHmortal
+ XPUSHu
XSRETURN_UV
XST_mUV
ZeroD
sv_utf8_decode
sv_utf8_downgrade
sv_utf8_encode
- sv_vcatpvf
- sv_vcatpvf_mg
- sv_vsetpvf
- sv_vsetpvf_mg
swash_init
tmps_grow
to_uni_lower_lc
vform
vload_module
vmess
- vnewSVpvf
vwarn
vwarner
warner
do_binmode
save_aelem
save_helem
- sv_catpvf_mg
- sv_setpvf_mg
=item perl 5.004_04
HeSVKEY_force
HeSVKEY_set
HeVAL
- PUSHu
SvSetMagicSV
SvSetMagicSV_nosteal
SvSetSV_nosteal
SvTAINTED
SvTAINTED_off
SvTAINTED_on
- XPUSHu
block_gimme
call_list
cv_const_sv
save_gp
start_subparse
sv_catpvf
+ sv_catpvf_mg
sv_cmp_locale
sv_derived_from
sv_gets
sv_setpvf
+ sv_setpvf_mg
sv_taint
sv_tainted
sv_untaint
+ sv_vcatpvf
+ sv_vcatpvf_mg
sv_vcatpvfn
+ sv_vsetpvf
+ sv_vsetpvf_mg
sv_vsetpvfn
unsharepvn
+ vnewSVpvf
=back
use strict;
use vars qw($VERSION @ISA $data);
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.00 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.00_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
@ISA = qw(DynaLoader);
POD Note that you mustn't have more than one global request for one
POD function in your project.
POD
-POD Function Static Request Global Request
-POD -----------------------------------------------------------------------------
-POD eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
-POD grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
-POD grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
-POD grok_number() NEED_grok_number NEED_grok_number_GLOBAL
-POD grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
-POD grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
-POD newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
-POD newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
-POD sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
-POD sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+POD Function Static Request Global Request
+POD -----------------------------------------------------------------------------------------
+POD eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
+POD grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
+POD grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
+POD grok_number() NEED_grok_number NEED_grok_number_GLOBAL
+POD grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
+POD grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
+POD newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+POD newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+POD sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
+POD sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+POD sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
+POD sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
+POD sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
+POD sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
+POD vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
POD
POD To avoid namespace conflicts, you can change the namespace of the
POD explicitly exported functions using the C<DPPP_NAMESPACE> macro.
PERL_USHORT_MAX|5.004000||p
PERL_USHORT_MIN|5.004000||p
PERL_VERSION|5.006000||p
-PL_DBsingle|||n
-PL_DBsub|||n
+PL_DBsingle|||pn
+PL_DBsub|||pn
PL_DBtrace|||n
PL_Sv|5.005000||p
PL_compiling|5.004050||p
PL_copline|5.005000||p
PL_curcop|5.004050||p
PL_curstash|5.004050||p
+PL_debstash|||p
PL_defgv|5.004050||p
+PL_diehook|||p
PL_dirty|5.004050||p
PL_dowarn|||pn
+PL_errgv|||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_last_in_gv|||n
PL_modglobal||5.005000|n
PL_na|5.004050||pn
+PL_no_modify|||p
PL_ofs_sv|||n
+PL_perl_destruct_level|||p
PL_perldb|5.004050||p
+PL_ppaddr|||p
PL_rsfp_filters|5.004050||p
PL_rsfp|5.004050||p
PL_rs|||n
PL_stack_base|||p
+PL_stack_sp|||p
PL_stdingv|5.004050||p
+PL_sv_arenaroot|||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
+PL_tainted|||p
+PL_tainting|||p
POPi|||n
POPl|||n
POPn|||n
PUSHn|||
PUSHp|||
PUSHs|||
-PUSHu||5.004000|
+PUSHu|5.004000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
XPUSHn|||
XPUSHp|||
XPUSHs|||
-XPUSHu||5.004000|
+XPUSHu|5.004000||p
XSRETURN_EMPTY|||
XSRETURN_IV|||
XSRETURN_NO|||
sv_bless|||
sv_cat_decode||5.008001|
sv_catpv_mg|5.006000||p
-sv_catpvf_mg_nocontext|||vn
-sv_catpvf_mg||5.004050|v
+sv_catpvf_mg_nocontext|||pvn
+sv_catpvf_mg|5.006000|5.004000|pv
sv_catpvf_nocontext|||vn
sv_catpvf||5.004000|v
sv_catpvn_flags||5.007002|
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.006000||p
-sv_setpvf_mg_nocontext|||vn
-sv_setpvf_mg||5.004050|v
+sv_setpvf_mg_nocontext|||pvn
+sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
sv_setpviv_mg||5.008001|
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade||5.007001|
sv_uv|5.006000||p
-sv_vcatpvf_mg||5.006000|
+sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn||5.004000|
-sv_vcatpvf||5.006000|
-sv_vsetpvf_mg||5.006000|
+sv_vcatpvf|5.006000|5.004000|p
+sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
-sv_vsetpvf||5.006000|
+sv_vsetpvf|5.006000|5.004000|p
svtype|||
swallow_bom|||
swash_fetch||5.007002|
vivify_ref|||
vload_module||5.006000|
vmess||5.006000|
-vnewSVpvf||5.006000|
+vnewSVpvf|5.006000|5.004000|p
vnormal||5.009002|
vnumify||5.009000|
vparse_body|||
if (exists $API{$func}{provided}) {
if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
$file{uses}{$func}++;
- push @{$global{uses}{$func}}, $filename;
my @deps = rec_depend($func);
if (@deps) {
$file{uses_deps}{$func} = \@deps;
for (@deps) {
$file{uses}{$_} = 0 unless exists $file{uses}{$_};
- push @{$global{uses}{$_}}, $filename;
}
}
for ($func, @deps) {
if (exists $need{$_}) {
$file{needs}{$_} = 'static';
- push @{$global{needs}{$_}}, $filename;
}
}
}
if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
if ($c =~ /\b$func\b/) {
$file{uses_todo}{$func}++;
- push @{$global{uses_todo}{$func}}, $filename;
}
}
}
while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
if (exists $need{$2}) {
$file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
- push @{$global{defined $3 ? 'needed_global' : 'needed_static'}{$2}}, $filename;
}
else {
warning("Possibly wrong #define $1 in $filename");
}
}
+ for (qw(uses needs uses_todo needed_global needed_static)) {
+ for $func (keys %{$file{$_}}) {
+ push @{$global{$_}{$func}}, $filename;
+ }
+ }
+
$files{$filename} = \%file;
}
sub rec_depend
{
my $func = shift;
+ my %seen;
return () unless exists $depends{$func};
- map { ($_, rec_depend($_)) } @{$depends{$func}};
+ grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
}
sub parse_version
#ifndef XSRETURN_UV
# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
#endif
+#ifndef PUSHu
+# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+#endif
+
+#ifndef XPUSHu
+# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#endif
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
-# define PL_Sv Sv
-# define PL_compiling compiling
-# define PL_copline copline
-# define PL_curcop curcop
-# define PL_curstash curstash
-# define PL_defgv defgv
-# define PL_dirty dirty
-# define PL_dowarn dowarn
-# define PL_hints hints
-# define PL_na na
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfp rsfp
-# define PL_stdingv stdingv
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-# define PL_hexdigit hexdigit
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_Sv Sv
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_debstash debstash
+# define PL_defgv defgv
+# define PL_diehook diehook
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_errgv errgv
+# define PL_hexdigit hexdigit
+# define PL_hints hints
+# define PL_na na
+# define PL_no_modify no_modify
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_ppaddr ppaddr
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# define PL_stdingv stdingv
+# define PL_sv_arenaroot sv_arenaroot
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_tainted tainted
+# define PL_tainting tainting
/* Replace: 0 */
#endif
#ifndef eval_pv
#if defined(NEED_eval_pv)
-static SV* DPPP_(eval_pv)(char *p, I32 croak_on_error);
+static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
-extern SV* DPPP_(eval_pv)(char *p, I32 croak_on_error);
+extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
-#define eval_pv(a,b) DPPP_(eval_pv)(aTHX_ a,b)
-#define Perl_eval_pv DPPP_(eval_pv)
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
-DPPP_(eval_pv)(char *p, I32 croak_on_error)
+DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
#ifndef newRV_noinc
#if defined(NEED_newRV_noinc)
-static SV * DPPP_(newRV_noinc)(SV *sv);
+static SV * DPPP_(my_newRV_noinc)(SV *sv);
static
#else
-extern SV * DPPP_(newRV_noinc)(SV *sv);
+extern SV * DPPP_(my_newRV_noinc)(SV *sv);
#endif
#ifdef newRV_noinc
# undef newRV_noinc
#endif
-#define newRV_noinc(a) DPPP_(newRV_noinc)(aTHX_ a)
-#define Perl_newRV_noinc DPPP_(newRV_noinc)
+#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
+#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
SV *
-DPPP_(newRV_noinc)(SV *sv)
+DPPP_(my_newRV_noinc)(SV *sv)
{
SV *rv = (SV *)newRV(sv);
SvREFCNT_dec(sv);
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
#if defined(NEED_newCONSTSUB)
-static void DPPP_(newCONSTSUB)(HV *stash, char *name, SV *sv);
+static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
static
#else
-extern void DPPP_(newCONSTSUB)(HV *stash, char *name, SV *sv);
+extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
#endif
-#define newCONSTSUB(a,b,c) DPPP_(newCONSTSUB)(aTHX_ a,b,c)
-#define Perl_newCONSTSUB DPPP_(newCONSTSUB)
+#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
-DPPP_(newCONSTSUB)(HV *stash, char *name, SV *sv)
+DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
{
U32 oldhints = PL_hints;
HV *old_cop_stash = PL_curcop->cop_stash;
#ifndef SvPV_nolen
#if defined(NEED_sv_2pv_nolen)
-static char * DPPP_(sv_2pv_nolen)(pTHX_ register SV *sv);
+static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
static
#else
-extern char * DPPP_(sv_2pv_nolen)(pTHX_ register SV *sv);
+extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
#endif
#ifdef sv_2pv_nolen
# undef sv_2pv_nolen
#endif
-#define sv_2pv_nolen(a) DPPP_(sv_2pv_nolen)(aTHX_ a)
-#define Perl_sv_2pv_nolen DPPP_(sv_2pv_nolen)
+#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
+#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
char *
-DPPP_(sv_2pv_nolen)(pTHX_ register SV *sv)
+DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
{
STRLEN n_a;
return sv_2pv(sv, &n_a);
#if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
#if defined(NEED_sv_2pvbyte)
-static char * DPPP_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
static
#else
-extern char * DPPP_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
#endif
#ifdef sv_2pvbyte
# undef sv_2pvbyte
#endif
-#define sv_2pvbyte(a,b) DPPP_(sv_2pvbyte)(aTHX_ a,b)
-#define Perl_sv_2pvbyte DPPP_(sv_2pvbyte)
+#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
char *
-DPPP_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
+DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
{
sv_utf8_downgrade(sv,0);
return SvPV(sv,*lp);
#ifndef sv_pvn_force
# define sv_pvn_force(sv, len) SvPV_force(sv, len)
#endif
+
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
+#if defined(NEED_vnewSVpvf)
+static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
+static
+#else
+extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
+#endif
+
+#ifdef vnewSVpvf
+# undef vnewSVpvf
+#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+
+SV *
+DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
+{
+ register SV *sv = newSV(0);
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ return sv;
+}
+
+#endif
+#endif
+
+/* sv_vcatpvf depends on sv_vcatpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_vsetpvf depends on sv_vsetpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
+#if defined(NEED_sv_catpvf_mg)
+static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+#endif
+
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
+
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
+#if defined(NEED_sv_catpvf_mg_nocontext)
+static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+#endif
+
+#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+
+#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+#ifndef sv_catpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
+# else
+# define sv_catpvf_mg Perl_sv_catpvf_mg
+# endif
+#endif
+
+/* sv_vcatpvf_mg depends on sv_vcatpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
+# define sv_vcatpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
+#if defined(NEED_sv_setpvf_mg)
+static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+#endif
+
+#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+
+#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
+#if defined(NEED_sv_setpvf_mg_nocontext)
+static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+#endif
+
+#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+
+#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+#ifndef sv_setpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
+# else
+# define sv_setpvf_mg Perl_sv_setpvf_mg
+# endif
+#endif
+
+/* sv_vsetpvf_mg depends on sv_vsetpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
+# define sv_vsetpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
#ifndef SvGETMAGIC
# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
#endif
#ifndef grok_numeric_radix
#if defined(NEED_grok_numeric_radix)
-static bool DPPP_(grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
static
#else
-extern bool DPPP_(grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
#endif
#ifdef grok_numeric_radix
# undef grok_numeric_radix
#endif
-#define grok_numeric_radix(a,b) DPPP_(grok_numeric_radix)(aTHX_ a,b)
-#define Perl_grok_numeric_radix DPPP_(grok_numeric_radix)
+#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
+#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
bool
-DPPP_(grok_numeric_radix)(pTHX_ const char **sp, const char *send)
+DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#ifdef PL_numeric_radix_sv
#ifndef grok_number
#if defined(NEED_grok_number)
-static int DPPP_(grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
static
#else
-extern int DPPP_(grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
#endif
#ifdef grok_number
# undef grok_number
#endif
-#define grok_number(a,b,c) DPPP_(grok_number)(aTHX_ a,b,c)
-#define Perl_grok_number DPPP_(grok_number)
+#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
+#define Perl_grok_number DPPP_(my_grok_number)
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
int
-DPPP_(grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
+DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
#ifndef grok_bin
#if defined(NEED_grok_bin)
-static UV DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
-extern UV DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
-#define grok_bin(a,b,c,d) DPPP_(grok_bin)(aTHX_ a,b,c,d)
-#define Perl_grok_bin DPPP_(grok_bin)
+#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
+#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
-DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
+DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_hex
#if defined(NEED_grok_hex)
-static UV DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
-extern UV DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
-#define grok_hex(a,b,c,d) DPPP_(grok_hex)(aTHX_ a,b,c,d)
-#define Perl_grok_hex DPPP_(grok_hex)
+#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
+#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
-DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
+DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_oct
#if defined(NEED_grok_oct)
-static UV DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
-extern UV DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
-#define grok_oct(a,b,c,d) DPPP_(grok_oct)(aTHX_ a,b,c,d)
-#define Perl_grok_oct DPPP_(grok_oct)
+#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
+#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
-DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
+DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
/* ---- from parts/inc/newRV ---- */
#define NEED_newRV_noinc
+/* ---- from parts/inc/sv_xpvf ---- */
+#define NEED_vnewSVpvf
+#define NEED_sv_catpvf_mg
+#define NEED_sv_catpvf_mg_nocontext
+#define NEED_sv_setpvf_mg
+#define NEED_sv_setpvf_mg_nocontext
+
/* ---- from parts/inc/SvPV ---- */
#define NEED_sv_2pv_nolen
#define NEED_sv_2pvbyte
extern void call_newCONSTSUB_2(void);
extern void call_newCONSTSUB_3(void);
+/* ---- from parts/inc/sv_xpvf ---- */
+static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
+{
+ SV *sv;
+ va_list args;
+ va_start(args, pat);
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+ sv = vnewSVpvf(pat, &args);
+#else
+ sv = newSVpv(pat, 0);
+#endif
+ va_end(args);
+ return sv;
+}
+
+static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+ sv_vcatpvf(sv, pat, &args);
+#else
+ sv_catpv(sv, pat);
+#endif
+ va_end(args);
+}
+
+static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+ sv_vsetpvf(sv, pat, &args);
+#else
+ sv_setpv(sv, pat);
+#endif
+ va_end(args);
+}
+
/* =========== END XSMISC =================================================== */
MODULE = Devel::PPPort PACKAGE = Devel::PPPort
RETVAL
##----------------------------------------------------------------------
+## XSUBs from parts/inc/sv_xpvf
+##----------------------------------------------------------------------
+
+SV *
+vnewSVpvf()
+ CODE:
+ RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
+ OUTPUT:
+ RETVAL
+
+SV *
+sv_vcatpvf(sv)
+ SV *sv
+ CODE:
+ RETVAL = newSVsv(sv);
+ test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
+ OUTPUT:
+ RETVAL
+
+SV *
+sv_vsetpvf(sv)
+ SV *sv
+ CODE:
+ RETVAL = newSVsv(sv);
+ test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
+ OUTPUT:
+ RETVAL
+
+void
+sv_catpvf_mg(sv)
+ SV *sv
+ CODE:
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+ sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
+#endif
+
+void
+Perl_sv_catpvf_mg(sv)
+ SV *sv
+ CODE:
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+ Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
+#endif
+
+void
+sv_catpvf_mg_nocontext(sv)
+ SV *sv
+ CODE:
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+#ifdef PERL_IMPLICIT_CONTEXT
+ sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
+#else
+ sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
+#endif
+#endif
+
+void
+sv_setpvf_mg(sv)
+ SV *sv
+ CODE:
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+ sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
+#endif
+
+void
+Perl_sv_setpvf_mg(sv)
+ SV *sv
+ CODE:
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+ Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
+#endif
+
+void
+sv_setpvf_mg_nocontext(sv)
+ SV *sv
+ CODE:
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
+#ifdef PERL_IMPLICIT_CONTEXT
+ sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
+#else
+ sv_setpvf_mg(sv, "%s-%d", "bar", 44);
+#endif
+#endif
+
+##----------------------------------------------------------------------
## XSUBs from parts/inc/SvPV
##----------------------------------------------------------------------
XSRETURN_UV()
PPCODE:
XSRETURN_UV(42);
+
+void
+PUSHu()
+ PREINIT:
+ dTARG;
+ PPCODE:
+ TARG = sv_newmortal();
+ EXTEND(SP, 1);
+ PUSHu(42);
+ XSRETURN(1);
+
+void
+XPUSHu()
+ PREINIT:
+ dTARG;
+ PPCODE:
+ TARG = sv_newmortal();
+ XPUSHu(43);
+ XSRETURN(1);
#
################################################################################
#
-# $Revision: 28 $
+# $Revision: 30 $
# $Author: mhx $
-# $Date: 2004/08/13 12:49:22 +0200 $
+# $Date: 2004/08/17 20:01:49 +0200 $
#
################################################################################
#
# check consistency
for (@api) {
if (exists $raw_todo{$_}) {
- warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
- . "todo for " . format_version($raw_todo{$_}) . "\n";
+ if ($raw_base{$_} eq $raw_todo{$_}) {
+ warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
+ . "todo for " . format_version($raw_todo{$_}) . "\n";
+ }
+ else {
+ check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
+ " (baseline revision: " . format_version($raw_base{$_}) . ").");
+ }
}
}
for (keys %{$data->{prototypes}}) {
$prototypes{$_} = $data->{prototypes}{$_};
- $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP($_)/g;
+ $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
}
my $out = $data->{implementation};
{
my $expr = shift;
- if ($expr =~ /^\s*version\s*(<|>|==|!=|>=|<=)\s*([\d._]+)\s*$/i) {
- my($op, $ver) = ($1, $2);
- my($r, $v, $s) = parse_version($ver);
- $r == 5 or die "only Perl revision 5 is supported\n";
- $op eq '==' and return "((PERL_VERSION == $v) && (PERL_SUBVERSION == $s))";
- $op eq '!=' and return "((PERL_VERSION != $v) || (PERL_SUBVERSION != $s))";
- $op =~ /([<>])/ and return "((PERL_VERSION $1 $v) || ((PERL_VERSION == $v) && (PERL_SUBVERSION $op $s)))";
- }
-
if ($expr =~ /^\s*need\s*(\w+)\s*$/i) {
my $func = $1;
my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
$explicit{$func} = 1;
- $proto =~ s/\b$func(?=\s*\()/$DPPP($func)/;
+ $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
my $embed = make_embed($e);
return "defined(NEED_$func)\n"
. "\n"
. "$embed\n"
. "\n"
- . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)"
+ . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
}
-
die "cannot expand preprocessor expression '$expr'\n";
}
if ($f->{flags}{n}) {
if ($f->{flags}{p}) {
- return "#define $n $DPPP($n)\n" .
- "#define Perl_$n $DPPP($n)";
+ return "#define $n $DPPP(my_$n)\n" .
+ "#define Perl_$n $DPPP(my_$n)";
}
else {
- return "#define $n $DPPP($n)";
+ return "#define $n $DPPP(my_$n)";
}
}
else {
#endif
UNDEF
if ($f->{flags}{p}) {
- return $undef . "#define $n($a) $DPPP($n)(aTHX_ $a)\n" .
- "#define Perl_$n $DPPP($n)";
+ if ($f->{flags}{f}) {
+ return "#define Perl_$n $DPPP(my_$n)";
+ }
+ else {
+ return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
+ "#define Perl_$n $DPPP(my_$n)";
+ }
}
else {
- return $undef . "#define $n($a) $DPPP($n)(aTHX_ $a)";
+ return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
}
}
}
#
################################################################################
#
-# $Revision: 28 $
+# $Revision: 30 $
# $Author: mhx $
-# $Date: 2004/08/13 12:49:22 +0200 $
+# $Date: 2004/08/17 20:01:49 +0200 $
#
################################################################################
#
use strict;
use vars qw($VERSION @ISA $data);
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.00 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.00_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
@ISA = qw(DynaLoader);
%include SvPV
+%include sv_xpvf
+
%include magic
%include cop
TODO:
-* add support for sv_vcatpvf / sv_vsetpvf / ...
-
* more documentation, more tests
* Resolve dependencies in Makefile.PL and remind of
#
################################################################################
#
-# $Revision: 9 $
+# $Revision: 10 $
# $Author: mhx $
-# $Date: 2004/08/13 12:49:50 +0200 $
+# $Date: 2004/08/17 20:56:15 +0200 $
#
################################################################################
#
#define NEED_newRV_noinc
#define NEED_sv_2pv_nolen
#define NEED_sv_2pvbyte
+#define NEED_sv_catpvf_mg
+#define NEED_sv_catpvf_mg_nocontext
+#define NEED_sv_setpvf_mg
+#define NEED_sv_setpvf_mg_nocontext
+#define NEED_vnewSVpvf
+
#include "ppport.h"
################################################################################
##
-## $Revision: 15 $
+## $Revision: 16 $
## $Author: mhx $
-## $Date: 2004/08/16 09:17:53 +0200 $
+## $Date: 2004/08/17 13:49:30 +0200 $
##
################################################################################
##
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
-# define PL_Sv Sv
-# define PL_compiling compiling
-# define PL_copline copline
-# define PL_curcop curcop
-# define PL_curstash curstash
-# define PL_defgv defgv
-# define PL_dirty dirty
-# define PL_dowarn dowarn
-# define PL_hints hints
-# define PL_na na
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfp rsfp
-# define PL_stdingv stdingv
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-# define PL_hexdigit hexdigit
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_Sv Sv
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_debstash debstash
+# define PL_defgv defgv
+# define PL_diehook diehook
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_errgv errgv
+# define PL_hexdigit hexdigit
+# define PL_hints hints
+# define PL_na na
+# define PL_no_modify no_modify
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_ppaddr ppaddr
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# define PL_stdingv stdingv
+# define PL_sv_arenaroot sv_arenaroot
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_tainted tainted
+# define PL_tainting tainting
/* Replace: 0 */
#endif
################################################################################
##
-## $Revision: 19 $
+## $Revision: 21 $
## $Author: mhx $
-## $Date: 2004/08/16 10:58:27 +0200 $
+## $Date: 2004/08/17 20:00:22 +0200 $
##
################################################################################
##
if (exists $API{$func}{provided}) {
if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
$file{uses}{$func}++;
- push @{$global{uses}{$func}}, $filename;
my @deps = rec_depend($func);
if (@deps) {
$file{uses_deps}{$func} = \@deps;
for (@deps) {
$file{uses}{$_} = 0 unless exists $file{uses}{$_};
- push @{$global{uses}{$_}}, $filename;
}
}
for ($func, @deps) {
if (exists $need{$_}) {
$file{needs}{$_} = 'static';
- push @{$global{needs}{$_}}, $filename;
}
}
}
if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
if ($c =~ /\b$func\b/) {
$file{uses_todo}{$func}++;
- push @{$global{uses_todo}{$func}}, $filename;
}
}
}
while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
if (exists $need{$2}) {
$file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
- push @{$global{defined $3 ? 'needed_global' : 'needed_static'}{$2}}, $filename;
}
else {
warning("Possibly wrong #define $1 in $filename");
}
}
+ for (qw(uses needs uses_todo needed_global needed_static)) {
+ for $func (keys %{$file{$_}}) {
+ push @{$global{$_}{$func}}, $filename;
+ }
+ }
+
$files{$filename} = \%file;
}
sub rec_depend
{
my $func = shift;
+ my %seen;
return () unless exists $depends{$func};
- map { ($_, rec_depend($_)) } @{$depends{$func}};
+ grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
}
sub parse_version
################################################################################
##
-## $Revision: 16 $
+## $Revision: 19 $
## $Author: mhx $
-## $Date: 2004/08/13 12:45:56 +0200 $
+## $Date: 2004/08/17 22:04:17 +0200 $
##
################################################################################
##
##
################################################################################
-=tests plan => 131
+=tests plan => 134
use File::Path qw/rmtree mkpath/;
+use Config;
my $tmp = 'ppptmp';
+my $inc = '';
+my $perl = find_perl();
rmtree($tmp) if -d $tmp;
mkpath($tmp) or die "mkpath $tmp: $!\n";
chdir($tmp) or die "chdir $tmp: $!\n";
-my $inc = '';
if ($ENV{'PERL_CORE'}) {
$inc = '-I../../lib' if -d '../../lib';
}
+if ($perl =~ m!^\./!) {
+ $perl = ".$perl";
+}
END {
chdir("..") if !-d $tmp && -d "../$tmp";
sub ppport
{
my @args = @_;
- print "# *** running $^X $inc ppport.h @args ***\n";
- my $out = join '', `$^X $inc ppport.h @args`;
+ print "# *** running $perl $inc ppport.h @args ***\n";
+ my $out = join '', `$perl $inc ppport.h @args`;
my $copy = $out;
$copy =~ s/^/# | /mg;
print "$copy\n";
}
}
+sub find_perl
+{
+ my $perl = $^X;
+
+ return $perl if $^O eq 'VMS';
+
+ my $exe = $Config{'_exe'} || '';
+
+ if ($perl =~ /^perl\Q$exe\E$/i) {
+ $perl = "perl$exe";
+ eval "require File::Spec";
+ if ($@) {
+ $perl = "./$perl";
+ } else {
+ $perl = File::Spec->catfile(File::Spec->curdir(), $perl);
+ }
+ }
+
+ if ($perl !~ /\Q$exe\E$/i) {
+ $perl .= $exe;
+ }
+
+ warn "find_perl: cannot find $perl from $^X" unless -f $perl;
+
+ return $perl;
+}
+
__DATA__
my $o = ppport(qw(--help));
SvPVutf8_force();
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o !~ /potentially required change/);
+ok(matches($o, '^Looks good', 'mi'), 2);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+#define NEED_grok_numeric_radix
+#define NEED_grok_number
+#include "ppport.h"
+
+GROK_NUMERIC_RADIX();
+grok_number();
+
+---------------------------- foo.c --------------------------------------------
+
+#include "ppport.h"
+
+call_pv();
+
--- /dev/null
+################################################################################
+##
+## $Revision: 2 $
+## $Author: mhx $
+## $Date: 2004/08/17 20:02:25 +0200 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004, 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
+
+vnewSVpvf
+sv_vcatpvf
+sv_vsetpvf
+
+sv_catpvf_mg
+sv_catpvf_mg_nocontext
+sv_vcatpvf_mg
+
+sv_setpvf_mg
+sv_setpvf_mg_nocontext
+sv_vsetpvf_mg
+
+=implementation
+
+#if { VERSION >= 5.004 } && !defined(vnewSVpvf)
+#if { NEED vnewSVpvf }
+
+SV *
+vnewSVpvf(pTHX_ const char *pat, va_list *args)
+{
+ register SV *sv = newSV(0);
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ return sv;
+}
+
+#endif
+#endif
+
+/* sv_vcatpvf depends on sv_vcatpvfn */
+#if { VERSION >= 5.004 } && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_vsetpvf depends on sv_vsetpvfn */
+#if { VERSION >= 5.004 } && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
+#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg)
+#if { NEED sv_catpvf_mg }
+
+void
+sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext)
+#if { NEED sv_catpvf_mg_nocontext }
+
+void
+sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+#ifndef sv_catpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
+# else
+# define sv_catpvf_mg Perl_sv_catpvf_mg
+# endif
+#endif
+
+/* sv_vcatpvf_mg depends on sv_vcatpvfn */
+#if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg)
+# define sv_vcatpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
+#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg)
+#if { NEED sv_setpvf_mg }
+
+void
+sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext)
+#if { NEED sv_setpvf_mg_nocontext }
+
+void
+sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+#ifndef sv_setpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
+# else
+# define sv_setpvf_mg Perl_sv_setpvf_mg
+# endif
+#endif
+
+/* sv_vsetpvf_mg depends on sv_vsetpvfn */
+#if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg)
+# define sv_vsetpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+=xsinit
+
+#define NEED_vnewSVpvf
+#define NEED_sv_catpvf_mg
+#define NEED_sv_catpvf_mg_nocontext
+#define NEED_sv_setpvf_mg
+#define NEED_sv_setpvf_mg_nocontext
+
+=xsmisc
+
+static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
+{
+ SV *sv;
+ va_list args;
+ va_start(args, pat);
+#if { VERSION >= 5.004 }
+ sv = vnewSVpvf(pat, &args);
+#else
+ sv = newSVpv(pat, 0);
+#endif
+ va_end(args);
+ return sv;
+}
+
+static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+#if { VERSION >= 5.004 }
+ sv_vcatpvf(sv, pat, &args);
+#else
+ sv_catpv(sv, pat);
+#endif
+ va_end(args);
+}
+
+static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+#if { VERSION >= 5.004 }
+ sv_vsetpvf(sv, pat, &args);
+#else
+ sv_setpv(sv, pat);
+#endif
+ va_end(args);
+}
+
+=xsubs
+
+SV *
+vnewSVpvf()
+ CODE:
+ RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
+ OUTPUT:
+ RETVAL
+
+SV *
+sv_vcatpvf(sv)
+ SV *sv
+ CODE:
+ RETVAL = newSVsv(sv);
+ test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
+ OUTPUT:
+ RETVAL
+
+SV *
+sv_vsetpvf(sv)
+ SV *sv
+ CODE:
+ RETVAL = newSVsv(sv);
+ test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
+ OUTPUT:
+ RETVAL
+
+void
+sv_catpvf_mg(sv)
+ SV *sv
+ CODE:
+#if { VERSION >= 5.004 }
+ sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
+#endif
+
+void
+Perl_sv_catpvf_mg(sv)
+ SV *sv
+ CODE:
+#if { VERSION >= 5.004 }
+ Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
+#endif
+
+void
+sv_catpvf_mg_nocontext(sv)
+ SV *sv
+ CODE:
+#if { VERSION >= 5.004 }
+#ifdef PERL_IMPLICIT_CONTEXT
+ sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
+#else
+ sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
+#endif
+#endif
+
+void
+sv_setpvf_mg(sv)
+ SV *sv
+ CODE:
+#if { VERSION >= 5.004 }
+ sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
+#endif
+
+void
+Perl_sv_setpvf_mg(sv)
+ SV *sv
+ CODE:
+#if { VERSION >= 5.004 }
+ Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
+#endif
+
+void
+sv_setpvf_mg_nocontext(sv)
+ SV *sv
+ CODE:
+#if { VERSION >= 5.004 }
+#ifdef PERL_IMPLICIT_CONTEXT
+ sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
+#else
+ sv_setpvf_mg(sv, "%s-%d", "bar", 44);
+#endif
+#endif
+
+=tests plan => 9
+
+use Tie::Hash;
+my %h;
+tie %h, 'Tie::StdHash';
+$h{foo} = 'foo-';
+$h{bar} = '';
+
+ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d');
+ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
+ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d');
+
+&Devel::PPPort::sv_catpvf_mg($h{foo});
+ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-');
+
+&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
+ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
+
+&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
+ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
+
+&Devel::PPPort::sv_setpvf_mg($h{bar});
+ok($h{bar}, $] >= 5.004 ? 'mhx-42' : '');
+
+&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
+ok($h{bar}, $] >= 5.004 ? 'foo-43' : '');
+
+&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
+ok($h{bar}, $] >= 5.004 ? 'bar-44' : '');
+
+
################################################################################
##
-## $Revision: 8 $
+## $Revision: 9 $
## $Author: mhx $
-## $Date: 2004/08/13 12:47:17 +0200 $
+## $Date: 2004/08/17 23:13:18 +0200 $
##
################################################################################
##
__UNDEFINED__ XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
__UNDEFINED__ XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
+__UNDEFINED__ PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+__UNDEFINED__ XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+
=xsubs
SV *
PPCODE:
XSRETURN_UV(42);
-=tests plan => 8
+void
+PUSHu()
+ PREINIT:
+ dTARG;
+ PPCODE:
+ TARG = sv_newmortal();
+ EXTEND(SP, 1);
+ PUSHu(42);
+ XSRETURN(1);
+
+void
+XPUSHu()
+ PREINIT:
+ dTARG;
+ PPCODE:
+ TARG = sv_newmortal();
+ XPUSHu(43);
+ XSRETURN(1);
+
+=tests plan => 10
ok(&Devel::PPPort::sv_setuv(42), 42);
ok(&Devel::PPPort::newSVuv(123), 123);
ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
ok(&Devel::PPPort::XSRETURN_UV(), 42);
+ok(&Devel::PPPort::PUSHu(), 42);
+ok(&Devel::PPPort::XPUSHu(), 43);
#
################################################################################
#
-# $Revision: 11 $
+# $Revision: 12 $
# $Author: mhx $
-# $Date: 2004/08/13 12:50:05 +0200 $
+# $Date: 2004/08/17 14:00:34 +0200 $
#
################################################################################
#
return \%todo;
}
+sub expand_version
+{
+ my($op, $ver) = @_;
+ my($r, $v, $s) = parse_version($ver);
+ $r == 5 or die "only Perl revision 5 is supported\n";
+ $op eq '==' and return "((PERL_VERSION == $v) && (PERL_SUBVERSION == $s))";
+ $op eq '!=' and return "((PERL_VERSION != $v) || (PERL_SUBVERSION != $s))";
+ $op =~ /([<>])/ and return "((PERL_VERSION $1 $v) || ((PERL_VERSION == $v) && (PERL_SUBVERSION $op $s)))";
+ die "cannot expand version expression ($op $ver)\n";
+}
+
sub parse_partspec
{
my $file = shift;
}
}
+ for $section (qw( implementation xsubs xsinit xsmisc xshead xsboot )) {
+ if (exists $data{$section}) {
+ $data{$section} =~ s/\{\s*version\s*(<|>|==|!=|>=|<=)\s*([\d._]+)\s*\}/expand_version($1, $2)/gei;
+ }
+ }
+
$data{provides} = \@prov;
$data{prototypes} = \%proto;
$data{OPTIONS} = \%options;
HeSVKEY_force # E
HeSVKEY_set # E
HeVAL # E
-PUSHu # U
SvSetMagicSV # U
SvSetMagicSV_nosteal # U
SvSetSV_nosteal # U
SvTAINTED # U
SvTAINTED_off # U
SvTAINTED_on # U
-XPUSHu # U
block_gimme # U
call_list # U
cv_const_sv # E
save_gp # U
start_subparse # E (Perl_start_subparse)
sv_catpvf # U
+sv_catpvf_mg # U
sv_cmp_locale # U
sv_derived_from # U
sv_gets # E (Perl_sv_gets)
sv_setpvf # U
+sv_setpvf_mg # U
sv_taint # U
sv_tainted # U
sv_untaint # U
+sv_vcatpvf # U
+sv_vcatpvf_mg # U
sv_vcatpvfn # U
+sv_vsetpvf # U
+sv_vsetpvf_mg # U
sv_vsetpvfn # U
unsharepvn # U
+vnewSVpvf # E
do_binmode # U
save_aelem # U
save_helem # U
-sv_catpvf_mg # U
-sv_setpvf_mg # U
sv_utf8_decode # U
sv_utf8_downgrade # U
sv_utf8_encode # U
-sv_vcatpvf # U
-sv_vcatpvf_mg # U
-sv_vsetpvf # U
-sv_vsetpvf_mg # U
swash_init # E
tmps_grow # U
to_uni_lower_lc # U
vform # E
vload_module # U
vmess # E
-vnewSVpvf # E
vwarn # U
vwarner # U
warner # U
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/cop instead.
+#
+################################################################################
+
+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';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..2\n";
+ }
+ else {
+ plan(tests => 2);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+my $package;
+{
+ package MyPackage;
+ $package = &Devel::PPPort::CopSTASHPV();
+}
+print "# $package\n";
+ok($package, "MyPackage");
+
+my $file = &Devel::PPPort::CopFILE();
+print "# $file\n";
+ok($file =~ /cop/i);
+
eval "use Test";
if ($@) {
require 'testutil.pl';
- print "1..131\n";
+ print "1..134\n";
}
else {
- plan(tests => 131);
+ plan(tests => 134);
}
}
$^W = 1;
use File::Path qw/rmtree mkpath/;
+use Config;
my $tmp = 'ppptmp';
+my $inc = '';
+my $perl = find_perl();
rmtree($tmp) if -d $tmp;
mkpath($tmp) or die "mkpath $tmp: $!\n";
chdir($tmp) or die "chdir $tmp: $!\n";
-my $inc = '';
if ($ENV{'PERL_CORE'}) {
$inc = '-I../../lib' if -d '../../lib';
}
+if ($perl =~ m!^\./!) {
+ $perl = ".$perl";
+}
END {
chdir("..") if !-d $tmp && -d "../$tmp";
sub ppport
{
my @args = @_;
- print "# *** running $^X $inc ppport.h @args ***\n";
- my $out = join '', `$^X $inc ppport.h @args`;
+ print "# *** running $perl $inc ppport.h @args ***\n";
+ my $out = join '', `$perl $inc ppport.h @args`;
my $copy = $out;
$copy =~ s/^/# | /mg;
print "$copy\n";
}
}
+sub find_perl
+{
+ my $perl = $^X;
+
+ return $perl if $^O eq 'VMS';
+
+ my $exe = $Config{'_exe'} || '';
+
+ if ($perl =~ /^perl\Q$exe\E$/i) {
+ $perl = "perl$exe";
+ eval "require File::Spec";
+ if ($@) {
+ $perl = "./$perl";
+ } else {
+ $perl = File::Spec->catfile(File::Spec->curdir(), $perl);
+ }
+ }
+
+ if ($perl !~ /\Q$exe\E$/i) {
+ $perl .= $exe;
+ }
+
+ warn "find_perl: cannot find $perl from $^X" unless -f $perl;
+
+ return $perl;
+}
+
__DATA__
my $o = ppport(qw(--help));
SvPVutf8_force();
+===============================================================================
+
+my $o = ppport(qw(--nochanges));
+ok($o !~ /potentially required change/);
+ok(matches($o, '^Looks good', 'mi'), 2);
+
+---------------------------- FooBar.xs ----------------------------------------
+
+#define NEED_grok_numeric_radix
+#define NEED_grok_number
+#include "ppport.h"
+
+GROK_NUMERIC_RADIX();
+grok_number();
+
+---------------------------- foo.c --------------------------------------------
+
+#include "ppport.h"
+
+call_pv();
+
--- /dev/null
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/sv_xpvf instead.
+#
+################################################################################
+
+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';
+ }
+
+ eval "use Test";
+ if ($@) {
+ require 'testutil.pl';
+ print "1..9\n";
+ }
+ else {
+ plan(tests => 9);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+use Tie::Hash;
+my %h;
+tie %h, 'Tie::StdHash';
+$h{foo} = 'foo-';
+$h{bar} = '';
+
+ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d');
+ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
+ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d');
+
+&Devel::PPPort::sv_catpvf_mg($h{foo});
+ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-');
+
+&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
+ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
+
+&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
+ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
+
+&Devel::PPPort::sv_setpvf_mg($h{bar});
+ok($h{bar}, $] >= 5.004 ? 'mhx-42' : '');
+
+&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
+ok($h{bar}, $] >= 5.004 ? 'foo-43' : '');
+
+&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
+ok($h{bar}, $] >= 5.004 ? 'bar-44' : '');
+
eval "use Test";
if ($@) {
require 'testutil.pl';
- print "1..8\n";
+ print "1..10\n";
}
else {
- plan(tests => 8);
+ plan(tests => 10);
}
}
ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
ok(&Devel::PPPort::XSRETURN_UV(), 42);
+ok(&Devel::PPPort::PUSHu(), 42);
+ok(&Devel::PPPort::XPUSHu(), 43);
projects / p5sagit/p5-mst-13.2.git / commitdiff