diff options
44 files changed, 745 insertions, 190 deletions
@@ -398,12 +398,14 @@ ext/Devel/PPPort/parts/inc/mPUSH Devel::PPPort include ext/Devel/PPPort/parts/inc/MY_CXT Devel::PPPort include ext/Devel/PPPort/parts/inc/newCONSTSUB Devel::PPPort include ext/Devel/PPPort/parts/inc/newRV Devel::PPPort include +ext/Devel/PPPort/parts/inc/podtest Devel::PPPort include 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/pvs Devel::PPPort include ext/Devel/PPPort/parts/inc/snprintf Devel::PPPort include ext/Devel/PPPort/parts/inc/SvPV Devel::PPPort include +ext/Devel/PPPort/parts/inc/SvREFCNT Devel::PPPort include ext/Devel/PPPort/parts/inc/Sv_set Devel::PPPort include ext/Devel/PPPort/parts/inc/sv_xpvf Devel::PPPort include ext/Devel/PPPort/parts/inc/threads Devel::PPPort include @@ -464,10 +466,12 @@ ext/Devel/PPPort/t/MY_CXT.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/TODO Devel::PPPort Todo +ext/Devel/PPPort/t/podtest.t Devel::PPPort test file ext/Devel/PPPort/t/ppphtest.t Devel::PPPort test file ext/Devel/PPPort/t/pvs.t Devel::PPPort test file ext/Devel/PPPort/t/snprintf.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 ext/Devel/PPPort/t/Sv_set.t Devel::PPPort test file ext/Devel/PPPort/t/sv_xpvf.t Devel::PPPort test file ext/Devel/PPPort/t/testutil.pl Devel::PPPort test utilities diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes index 6654bb087b..458bc22184 100755 --- a/ext/Devel/PPPort/Changes +++ b/ext/Devel/PPPort/Changes @@ -1,3 +1,28 @@ +3.08_02 - 2006-05-22 + + * fix a POD error + * added POD test + * changed hv_stores() to omit the hash parameter + * improve soak script + - can now search directories for perl executables + - can use only perl binaries of at least a certain + revision using the --min option + - sorts tests by perl version + - shows a summary of failed versions + * added support for the following API + PERL_USE_GCC_BRACE_GROUPS + PoisonFree + PoisonNew + PoisonWith + SvREFCNT_inc + SvREFCNT_inc_NN + SvREFCNT_inc_simple + SvREFCNT_inc_simple_NN + SvREFCNT_inc_simple_void + SvREFCNT_inc_simple_void_NN + SvREFCNT_inc_void + SvREFCNT_inc_void_NN + 3.08_01 - 2006-05-20 * update NOOP and dNOOP to include lint directives diff --git a/ext/Devel/PPPort/PPPort.pm b/ext/Devel/PPPort/PPPort.pm index df6d9c9430..9b56c56c1d 100644 --- a/ext/Devel/PPPort/PPPort.pm +++ b/ext/Devel/PPPort/PPPort.pm @@ -8,9 +8,9 @@ # ################################################################################ # -# $Revision: 42 $ +# $Revision: 43 $ # $Author: mhx $ -# $Date: 2006/05/18 23:13:47 +0200 $ +# $Date: 2006/05/22 00:51:20 +0200 $ # ################################################################################ # @@ -280,6 +280,7 @@ in older Perl releases: PERL_UNUSED_VAR PERL_UQUAD_MAX PERL_UQUAD_MIN + PERL_USE_GCC_BRACE_GROUPS PERL_USHORT_MAX PERL_USHORT_MIN PERL_VERSION @@ -320,6 +321,9 @@ in older Perl releases: pMY_CXT pMY_CXT_ Poison + PoisonFree + PoisonNew + PoisonWith pTHX pTHX_ PTR2IV @@ -376,6 +380,14 @@ in older Perl releases: SvPVbyte SvPVX_const SvPVX_mutable + SvREFCNT_inc + SvREFCNT_inc_NN + SvREFCNT_inc_simple + SvREFCNT_inc_simple_NN + SvREFCNT_inc_simple_void + SvREFCNT_inc_simple_void_NN + SvREFCNT_inc_void + SvREFCNT_inc_void_NN SvRV_set SvSTASH_set SvUV @@ -469,14 +481,6 @@ Perl below which it is unsupported: MULTICALL POP_MULTICALL PUSH_MULTICALL - PoisonNew - PoisonWith - SvREFCNT_inc_NN - SvREFCNT_inc_simple - SvREFCNT_inc_simple_NN - SvREFCNT_inc_simple_void - SvREFCNT_inc_void - SvREFCNT_inc_void_NN gv_name_set my_vsnprintf newXS_flags @@ -1004,7 +1008,7 @@ require DynaLoader; use strict; use vars qw($VERSION @ISA $data); -$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; +$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; @ISA = qw(DynaLoader); @@ -1382,8 +1386,8 @@ SKIP |>=head1 SEE ALSO |> |>See L<Devel::PPPort>. - -=cut +|> +|>=cut use strict; @@ -1620,6 +1624,7 @@ PERL_UNUSED_DECL|5.007002||p PERL_UNUSED_VAR|5.007002||p PERL_UQUAD_MAX|5.004000||p PERL_UQUAD_MIN|5.004000||p +PERL_USE_GCC_BRACE_GROUPS|||p PERL_USHORT_MAX|5.004000||p PERL_USHORT_MIN|5.004000||p PERL_VERSION|5.006000||p @@ -1684,6 +1689,7 @@ PUSHu|5.004000||p PUTBACK||| PerlIO_clearerr||5.007003| PerlIO_close||5.007003| +PerlIO_context_layers||| PerlIO_eof||5.007003| PerlIO_error||5.007003| PerlIO_fileno||5.007003| @@ -1706,8 +1712,9 @@ PerlIO_unread||5.007003| PerlIO_write||5.007003| Perl_warner_nocontext|5.006000||p Perl_warner|5.006000||p -PoisonNew||5.009004| -PoisonWith||5.009004| +PoisonFree|5.009004||p +PoisonNew|5.009004||p +PoisonWith|5.009004||p Poison|5.008000||p RETVAL|||n Renewc||| @@ -1803,13 +1810,14 @@ SvPVutf8||5.006000| SvPVx||| SvPV||| SvREFCNT_dec||| -SvREFCNT_inc_NN||5.009004| -SvREFCNT_inc_simple_NN||5.009004| -SvREFCNT_inc_simple_void||5.009004| -SvREFCNT_inc_simple||5.009004| -SvREFCNT_inc_void_NN||5.009004| -SvREFCNT_inc_void||5.009004| -SvREFCNT_inc||| +SvREFCNT_inc_NN|5.009004||p +SvREFCNT_inc_simple_NN|5.009004||p +SvREFCNT_inc_simple_void_NN|5.009004||p +SvREFCNT_inc_simple_void|5.009004||p +SvREFCNT_inc_simple|5.009004||p +SvREFCNT_inc_void_NN|5.009004||p +SvREFCNT_inc_void|5.009004||p +SvREFCNT_inc|||p SvREFCNT||| SvROK_off||| SvROK_on||| @@ -2800,8 +2808,10 @@ reentrant_retry|||vn reentrant_size||| ref_array_or_hash||| refcounted_he_chain_2hv||| +refcounted_he_fetch||| refcounted_he_free||| refcounted_he_new||| +refcounted_he_value||| refkids||| refto||| ref||5.009003| @@ -4372,8 +4382,20 @@ __DATA__ #endif #endif +#ifndef PoisonWith +# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) +#endif + +#ifndef PoisonNew +# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) +#endif + +#ifndef PoisonFree +# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) +#endif + #ifndef Poison -# define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)) +# define Poison(d,n,t) PoisonFree(d,n,t) #endif #ifndef Newx # define Newx(v,n,t) New(0,v,n,t) @@ -4512,15 +4534,21 @@ typedef NVTYPE NV; # define EXTERN_C extern #endif -#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN -# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) +#if defined(PERL_GCC_PEDANTIC) +# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN # define PERL_GCC_BRACE_GROUPS_FORBIDDEN # endif #endif +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +# ifndef PERL_USE_GCC_BRACE_GROUPS +# define PERL_USE_GCC_BRACE_GROUPS +# endif +#endif + #undef STMT_START #undef STMT_END -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +#ifdef PERL_USE_GCC_BRACE_GROUPS # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ # define STMT_END ) #else @@ -4995,6 +5023,78 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) # endif #endif +#ifndef SvREFCNT_inc +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (SvREFCNT(_sv))++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc(sv) \ + ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_simple +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_simple(sv) \ + ({ \ + if (sv) \ + (SvREFCNT(sv))++; \ + (SV *)(sv); \ + }) +# else +# define SvREFCNT_inc_simple(sv) \ + ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_NN +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_NN(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + SvREFCNT(_sv)++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc_NN(sv) \ + (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) +# endif +#endif + +#ifndef SvREFCNT_inc_void +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_void(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (void)(SvREFCNT(_sv)++); \ + }) +# else +# define SvREFCNT_inc_void(sv) \ + (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) +# endif +#endif +#ifndef SvREFCNT_inc_simple_void +# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END +#endif + +#ifndef SvREFCNT_inc_simple_NN +# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) +#endif + +#ifndef SvREFCNT_inc_void_NN +# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) +#endif + +#ifndef SvREFCNT_inc_simple_void_NN +# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) +#endif + #ifndef SvPV_nolen #if defined(NEED_sv_2pv_nolen) @@ -5597,11 +5697,11 @@ DPPP_(my_warner)(U32 err, const char *pat, ...) #endif #ifndef hv_fetchs -# define hv_fetchs(hv,key,lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) +# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) #endif #ifndef hv_stores -# define hv_stores(hv,key,val,hash) hv_store(hv, key "", sizeof(key) - 1, val, hash) +# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) #endif #ifndef SvGETMAGIC # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END diff --git a/ext/Devel/PPPort/PPPort.xs b/ext/Devel/PPPort/PPPort.xs index b658e89920..4757b561fc 100644 --- a/ext/Devel/PPPort/PPPort.xs +++ b/ext/Devel/PPPort/PPPort.xs @@ -948,7 +948,7 @@ hv_stores(hv, sv) SV *hv SV *sv PPCODE: - hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv), 0); + hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv)); ##---------------------------------------------------------------------- ## XSUBs from parts/inc/snprintf @@ -1117,6 +1117,43 @@ SvPV_nolen(sv) RETVAL ##---------------------------------------------------------------------- +## XSUBs from parts/inc/SvREFCNT +##---------------------------------------------------------------------- + +void +SvREFCNT() + PREINIT: + SV *sv, *svr; + PPCODE: + sv = newSV(0); + XPUSHs(newSViv(SvREFCNT(sv) == 1)); + svr = SvREFCNT_inc(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 2)); + svr = SvREFCNT_inc_simple(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 3)); + svr = SvREFCNT_inc_NN(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 4)); + svr = SvREFCNT_inc_simple_NN(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 5)); + SvREFCNT_inc_void(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 6)); + SvREFCNT_inc_simple_void(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 7)); + SvREFCNT_inc_void_NN(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 8)); + SvREFCNT_inc_simple_void_NN(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 9)); + while (SvREFCNT(sv) > 1) + SvREFCNT_dec(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 1)); + SvREFCNT_dec(sv); + XSRETURN(14); + +##---------------------------------------------------------------------- ## XSUBs from parts/inc/threads ##---------------------------------------------------------------------- diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL index c6a3f8b844..cbe65b2328 100644 --- a/ext/Devel/PPPort/PPPort_pm.PL +++ b/ext/Devel/PPPort/PPPort_pm.PL @@ -4,9 +4,9 @@ # ################################################################################ # -# $Revision: 42 $ +# $Revision: 43 $ # $Author: mhx $ -# $Date: 2006/05/18 23:13:47 +0200 $ +# $Date: 2006/05/22 00:51:20 +0200 $ # ################################################################################ # @@ -335,9 +335,9 @@ __DATA__ # ################################################################################ # -# $Revision: 42 $ +# $Revision: 43 $ # $Author: mhx $ -# $Date: 2006/05/18 23:13:47 +0200 $ +# $Date: 2006/05/22 00:51:20 +0200 $ # ################################################################################ # @@ -499,7 +499,7 @@ require DynaLoader; use strict; use vars qw($VERSION @ISA $data); -$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; +$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; @ISA = qw(DynaLoader); @@ -597,6 +597,8 @@ __DATA__ %include format +%include SvREFCNT + %include SvPV %include Sv_set diff --git a/ext/Devel/PPPort/TODO b/ext/Devel/PPPort/TODO index 6214d6c0ca..344ef9f929 100644 --- a/ext/Devel/PPPort/TODO +++ b/ext/Devel/PPPort/TODO @@ -1,13 +1,9 @@ TODO: -* see if we can add more stuff from recent perls - * see if we can implement sv_catpvf() for < 5.004 * add hv_stores() to blead -* Andy's SvREFCNT_inc patches? - * MULTICALL ? * improve apicheck (things like utf8_mg_pos_init() are diff --git a/ext/Devel/PPPort/mktests.PL b/ext/Devel/PPPort/mktests.PL index 98ef486a06..24889b23ef 100644 --- a/ext/Devel/PPPort/mktests.PL +++ b/ext/Devel/PPPort/mktests.PL @@ -4,9 +4,9 @@ # ################################################################################ # -# $Revision: 21 $ +# $Revision: 22 $ # $Author: mhx $ -# $Date: 2006/01/14 18:07:56 +0100 $ +# $Date: 2006/05/21 23:15:21 +0200 $ # ################################################################################ # @@ -77,12 +77,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..__PLAN__\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (__PLAN__) { + load(); plan(tests => __PLAN__); } } diff --git a/ext/Devel/PPPort/parts/apidoc.fnc b/ext/Devel/PPPort/parts/apidoc.fnc index 337e21792a..09cde0e49d 100644 --- a/ext/Devel/PPPort/parts/apidoc.fnc +++ b/ext/Devel/PPPort/parts/apidoc.fnc @@ -118,6 +118,7 @@ Am|SV*|ST|int ix Am|SV*|SvREFCNT_inc_NN|SV* sv Am|SV*|SvREFCNT_inc_simple_NN|SV* sv Am|SV*|SvREFCNT_inc_simple|SV* sv +Am|SV*|SvREFCNT_inc_simple_void_NN|SV* sv Am|SV*|SvREFCNT_inc_simple_void|SV* sv Am|SV*|SvREFCNT_inc|SV* sv Am|SV*|SvREFCNT_inc_void_NN|SV* sv @@ -183,6 +184,7 @@ Am|void|mXPUSHu|UV uv Am|void|Newxc|void* ptr|int nitems|type|cast Am|void|Newx|void* ptr|int nitems|type Am|void|Newxz|void* ptr|int nitems|type +Am|void|PoisonFree|void* dest|int nitems|type Am|void|PoisonNew|void* dest|int nitems|type Am|void|Poison|void* dest|int nitems|type Am|void|PoisonWith|void* dest|int nitems|type|U8 byte diff --git a/ext/Devel/PPPort/parts/base/5009004 b/ext/Devel/PPPort/parts/base/5009004 index eca5e86786..47cb53d835 100644 --- a/ext/Devel/PPPort/parts/base/5009004 +++ b/ext/Devel/PPPort/parts/base/5009004 @@ -2,12 +2,14 @@ MULTICALL # E POP_MULTICALL # E PUSH_MULTICALL # E +PoisonFree # E PoisonNew # E PoisonWith # E SvREFCNT_inc_NN # E SvREFCNT_inc_simple # E SvREFCNT_inc_simple_NN # E SvREFCNT_inc_simple_void # E +SvREFCNT_inc_simple_void_NN # E SvREFCNT_inc_void # E SvREFCNT_inc_void_NN # E SvSTASH_set # E diff --git a/ext/Devel/PPPort/parts/embed.fnc b/ext/Devel/PPPort/parts/embed.fnc index dac19c7e3c..bc12ba195c 100644 --- a/ext/Devel/PPPort/parts/embed.fnc +++ b/ext/Devel/PPPort/parts/embed.fnc @@ -308,6 +308,9 @@ ApdR |SV* |hv_iterval |NN HV* tb|NN HE* entry Ap |void |hv_ksplit |NN HV* hv|IV newmax Apdbm |void |hv_magic |NN HV* hv|NULLOK GV* gv|int how dpoM |HV * |refcounted_he_chain_2hv|NULLOK const struct refcounted_he *c +XEpoM |SV * |refcounted_he_fetch|NN const struct refcounted_he *chain \ + |NULLOK SV *keysv|NULLOK const char *key \ + |STRLEN klen, int flags, U32 hash dpoM |void |refcounted_he_free|NULLOK struct refcounted_he *he dpoM |struct refcounted_he *|refcounted_he_new \ |NULLOK struct refcounted_he *const parent \ @@ -1094,6 +1097,7 @@ sM |SV* |hv_delete_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key sM |HE* |hv_fetch_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key \ |STRLEN klen|int flags|int action|NULLOK SV* val|U32 hash sM |void |clear_placeholders |NN HV* hb|U32 items +sM |SV * |refcounted_he_value |NN const struct refcounted_he *he #endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) @@ -1500,6 +1504,8 @@ Apn |int |my_socketpair |int family|int type|int protocol|int fd[2] pMXE |SV* |sv_setsv_cow |NN SV* dsv|NN SV* ssv #endif +Aop |const char *|PerlIO_context_layers|NULLOK const char *mode + #if defined(USE_PERLIO) && !defined(USE_SFIO) Ap |int |PerlIO_close |NULLOK PerlIO *f Ap |int |PerlIO_fill |NULLOK PerlIO *f diff --git a/ext/Devel/PPPort/parts/inc/SvREFCNT b/ext/Devel/PPPort/parts/inc/SvREFCNT new file mode 100644 index 0000000000..b9360fcd5e --- /dev/null +++ b/ext/Devel/PPPort/parts/inc/SvREFCNT @@ -0,0 +1,130 @@ +################################################################################ +## +## $Revision: 1 $ +## $Author: mhx $ +## $Date: 2006/05/22 00:51:52 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2006, 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 + +SvREFCNT_inc +SvREFCNT_inc_simple +SvREFCNT_inc_NN +SvREFCNT_inc_void +__UNDEFINED__ + +=implementation + +#ifndef SvREFCNT_inc +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (SvREFCNT(_sv))++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc(sv) \ + ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_simple +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_simple(sv) \ + ({ \ + if (sv) \ + (SvREFCNT(sv))++; \ + (SV *)(sv); \ + }) +# else +# define SvREFCNT_inc_simple(sv) \ + ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_NN +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_NN(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + SvREFCNT(_sv)++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc_NN(sv) \ + (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) +# endif +#endif + +#ifndef SvREFCNT_inc_void +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_void(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (void)(SvREFCNT(_sv)++); \ + }) +# else +# define SvREFCNT_inc_void(sv) \ + (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) +# endif +#endif + +__UNDEFINED__ SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END +__UNDEFINED__ SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) +__UNDEFINED__ SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) +__UNDEFINED__ SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) + +=xsubs + +void +SvREFCNT() + PREINIT: + SV *sv, *svr; + PPCODE: + sv = newSV(0); + XPUSHs(newSViv(SvREFCNT(sv) == 1)); + svr = SvREFCNT_inc(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 2)); + svr = SvREFCNT_inc_simple(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 3)); + svr = SvREFCNT_inc_NN(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 4)); + svr = SvREFCNT_inc_simple_NN(sv); + XPUSHs(newSViv(sv == svr)); + XPUSHs(newSViv(SvREFCNT(sv) == 5)); + SvREFCNT_inc_void(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 6)); + SvREFCNT_inc_simple_void(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 7)); + SvREFCNT_inc_void_NN(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 8)); + SvREFCNT_inc_simple_void_NN(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 9)); + while (SvREFCNT(sv) > 1) + SvREFCNT_dec(sv); + XPUSHs(newSViv(SvREFCNT(sv) == 1)); + SvREFCNT_dec(sv); + XSRETURN(14); + +=tests plan => 14 + +for (Devel::PPPort::SvREFCNT()) { + ok(defined $_ and $_); +} + diff --git a/ext/Devel/PPPort/parts/inc/memory b/ext/Devel/PPPort/parts/inc/memory index 8e2eb3dc31..2117893965 100644 --- a/ext/Devel/PPPort/parts/inc/memory +++ b/ext/Devel/PPPort/parts/inc/memory @@ -1,12 +1,12 @@ ################################################################################ ## -## $Revision: 1 $ +## $Revision: 2 $ ## $Author: mhx $ -## $Date: 2005/10/30 11:26:42 +0100 $ +## $Date: 2006/05/22 00:50:25 +0200 $ ## ################################################################################ ## -## Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz. +## Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. ## Version 2.x, Copyright (C) 2001, Paul Marquess. ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. ## @@ -37,7 +37,10 @@ __UNDEFINED__ ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) __UNDEFINED__ ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) #endif -__UNDEFINED__ Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)) +__UNDEFINED__ PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) +__UNDEFINED__ PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) +__UNDEFINED__ PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) +__UNDEFINED__ Poison(d,n,t) PoisonFree(d,n,t) __UNDEFINED__ Newx(v,n,t) New(0,v,n,t) __UNDEFINED__ Newxc(v,n,t,c) Newc(0,v,n,t,c) diff --git a/ext/Devel/PPPort/parts/inc/misc b/ext/Devel/PPPort/parts/inc/misc index 17a81e7851..ab4b7b9079 100644 --- a/ext/Devel/PPPort/parts/inc/misc +++ b/ext/Devel/PPPort/parts/inc/misc @@ -1,8 +1,8 @@ ################################################################################ ## -## $Revision: 35 $ +## $Revision: 36 $ ## $Author: mhx $ -## $Date: 2006/05/19 23:57:26 +0200 $ +## $Date: 2006/05/22 00:51:01 +0200 $ ## ################################################################################ ## @@ -23,6 +23,7 @@ PERL_UNUSED_ARG PERL_UNUSED_VAR PERL_UNUSED_CONTEXT PERL_GCC_BRACE_GROUPS_FORBIDDEN +PERL_USE_GCC_BRACE_GROUPS NVTYPE INT2PTR PTRV @@ -162,15 +163,21 @@ typedef NVTYPE NV; # define EXTERN_C extern #endif -#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN -# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) +#if defined(PERL_GCC_PEDANTIC) +# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN # define PERL_GCC_BRACE_GROUPS_FORBIDDEN # endif #endif +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +# ifndef PERL_USE_GCC_BRACE_GROUPS +# define PERL_USE_GCC_BRACE_GROUPS +# endif +#endif + #undef STMT_START #undef STMT_END -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +#ifdef PERL_USE_GCC_BRACE_GROUPS # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ # define STMT_END ) #else diff --git a/ext/Devel/PPPort/parts/inc/podtest b/ext/Devel/PPPort/parts/inc/podtest new file mode 100644 index 0000000000..c4f0130356 --- /dev/null +++ b/ext/Devel/PPPort/parts/inc/podtest @@ -0,0 +1,46 @@ +################################################################################ +## +## $Revision: 2 $ +## $Author: mhx $ +## $Date: 2006/05/22 00:50:40 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2006, 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. +## +################################################################################ + +=tests plan => 0 + +my @pods = qw( HACKERS PPPort.pm ppport.h ); + +# Try loading Test::Pod +eval q{ + use Test::Pod; + $Test::Pod::VERSION >= 0.95 + or die "Test::Pod version only $Test::Pod::VERSION"; + import Test::Pod tests => scalar @pods; +}; + +my $TP = $@ eq ''; + +unless ($TP) { + load(); + plan(tests => scalar @pods); +} + +for (@pods) { + print "# checking $_\n"; + if ($TP) { + pod_file_ok($_); + } + else { + skip("skip: Test::Pod >= 0.95 required", 0); + } +} + diff --git a/ext/Devel/PPPort/parts/inc/ppphbin b/ext/Devel/PPPort/parts/inc/ppphbin index 13d5b540ab..62dac9bf26 100644 --- a/ext/Devel/PPPort/parts/inc/ppphbin +++ b/ext/Devel/PPPort/parts/inc/ppphbin @@ -1,8 +1,8 @@ ################################################################################ ## -## $Revision: 31 $ +## $Revision: 32 $ ## $Author: mhx $ -## $Date: 2006/01/14 18:08:02 +0100 $ +## $Date: 2006/05/21 23:14:16 +0200 $ ## ################################################################################ ## @@ -19,8 +19,6 @@ =implementation -=cut - use strict; my %opt = ( diff --git a/ext/Devel/PPPort/parts/inc/ppphdoc b/ext/Devel/PPPort/parts/inc/ppphdoc index 76efe7b60b..0b79cc0cd9 100644 --- a/ext/Devel/PPPort/parts/inc/ppphdoc +++ b/ext/Devel/PPPort/parts/inc/ppphdoc @@ -1,8 +1,8 @@ ################################################################################ ## -## $Revision: 25 $ +## $Revision: 26 $ ## $Author: mhx $ -## $Date: 2006/01/14 18:08:00 +0100 $ +## $Date: 2006/05/21 23:14:18 +0200 $ ## ################################################################################ ## @@ -332,3 +332,5 @@ modify it under the same terms as Perl itself. See L<Devel::PPPort>. +=cut + diff --git a/ext/Devel/PPPort/parts/inc/pvs b/ext/Devel/PPPort/parts/inc/pvs index 83fb6e8ac7..b4e3d3cfb8 100644 --- a/ext/Devel/PPPort/parts/inc/pvs +++ b/ext/Devel/PPPort/parts/inc/pvs @@ -1,8 +1,8 @@ ################################################################################ ## -## $Revision: 2 $ +## $Revision: 3 $ ## $Author: mhx $ -## $Date: 2006/05/19 23:00:18 +0200 $ +## $Date: 2006/05/22 12:27:50 +0200 $ ## ################################################################################ ## @@ -31,8 +31,8 @@ __UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1) __UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) __UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) __UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) -__UNDEFINED__ hv_fetchs(hv,key,lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) -__UNDEFINED__ hv_stores(hv,key,val,hash) hv_store(hv, key "", sizeof(key) - 1, val, hash) +__UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) +__UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) =xsubs @@ -69,7 +69,7 @@ hv_stores(hv, sv) SV *hv SV *sv PPCODE: - hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv), 0); + hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv)); =tests plan => 7 diff --git a/ext/Devel/PPPort/parts/todo/5009004 b/ext/Devel/PPPort/parts/todo/5009004 index 78a700dbc0..2451e8157f 100644 --- a/ext/Devel/PPPort/parts/todo/5009004 +++ b/ext/Devel/PPPort/parts/todo/5009004 @@ -2,14 +2,6 @@ MULTICALL # E POP_MULTICALL # E PUSH_MULTICALL # E -PoisonNew # E -PoisonWith # E -SvREFCNT_inc_NN # E -SvREFCNT_inc_simple # E -SvREFCNT_inc_simple_NN # E -SvREFCNT_inc_simple_void # E -SvREFCNT_inc_void # E -SvREFCNT_inc_void_NN # E gv_name_set # U my_vsnprintf # U newXS_flags # E diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak index 7b7ffe764c..b0ee503fda 100644 --- a/ext/Devel/PPPort/soak +++ b/ext/Devel/PPPort/soak @@ -7,9 +7,9 @@ # ################################################################################ # -# $Revision: 9 $ +# $Revision: 11 $ # $Author: mhx $ -# $Date: 2006/01/14 18:07:57 +0100 $ +# $Date: 2006/05/22 01:57:33 +0200 $ # ################################################################################ # @@ -29,10 +29,11 @@ use warnings; use ExtUtils::MakeMaker; use Getopt::Long; use Pod::Usage; +use File::Find; use List::Util qw(max); use Config; -my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; +my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; $| = 1; my $verbose = 0; @@ -40,13 +41,17 @@ my $MAKE = $Config{make} || 'make'; my %OPT = ( verbose => 0, make => $Config{make} || 'make', + min => '5.000', ); -GetOptions(\%OPT, qw(verbose make=s mmargs=s@)) or pod2usage(2); +GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@)) or pod2usage(2); $OPT{mmargs} = [''] unless exists $OPT{mmargs}; +$OPT{min} = parse_version($OPT{min}) - 1e-10; -my @GoodPerls = @ARGV ? @ARGV : FindPerls(); +my @GoodPerls = sort { eval { parse_version($a) <=> parse_version($b) } or $a cmp $b } + grep { my $v = eval { parse_version($_) }; $@ or $v >= $OPT{min} } + @ARGV ? SearchPerls(@ARGV) : FindPerls(); my $maxlen = max(map length, @GoodPerls) + 3; my $mmalen = max(map length, @{$OPT{mmargs}}); $maxlen += $mmalen+3 if $mmalen > 0; @@ -58,6 +63,8 @@ my(@good, @bad, $total); runit("$^X Makefile.PL") && runit("$MAKE realclean") or die "Cannot run $^X Makefile.PL && $MAKE realclean\n"; +print "Testing ", scalar @GoodPerls, " versions/configurations...\n\n"; + for my $perl (@GoodPerls) { for my $mm (@{$OPT{mmargs}}) { my $config = $mm =~ /\S+/ ? " ($mm)" : ''; @@ -82,9 +89,15 @@ for my $perl (@GoodPerls) { } } -if ($verbose && @bad) { - print "\nFailed with:\n", map " $_\n", @bad; +if (@bad) { + print "\nFailed with:\n"; + for my $fail (@bad) { + my($perl, $mm) = @$fail; + my $config = $mm =~ /\S+/ ? " ($mm)" : ''; + print " $perl$config\n"; + } } + print "\nPassed with ", scalar @good, " of $total versions/configurations.\n\n"; exit scalar @bad; @@ -147,6 +160,49 @@ sub FindPerls return @GoodPerls; } +sub SearchPerls +{ + my @args = @_; + my @perls; + + for my $arg (@args) { + if (-d $arg) { + my @found; + print "Searching for Perl binaries in '$arg'...\n"; + find(sub { + if ($File::Find::name =~ m!bin/perl5\.!) { + eval { parse_version($File::Find::name) }; + $@ or push @found, $File::Find::name; + } + }, $arg); + printf "Found %d Perl binar%s in '%s'.\n\n", scalar @found, @found == 1 ? 'y' : 'ies', $arg; + push @perls, @found; + } + else { + push @perls, $arg; + } + } + + return @perls; +} + +sub parse_version +{ + my $ver = shift; + + $ver = $1 if $ver =~ /perl(5\.[\d\._]+)/; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return $1 + 1e-3*$2 + 1e-6*$3; + } + elsif ($ver =~ /^\d+\.[\d_]+$/) { + $ver =~ s/_//g; + return $ver; + } + + die "cannot parse version '$ver'\n"; +} + package NoSTDOUT; use Tie::Handle; @@ -167,6 +223,7 @@ soak - Test Perl modules with multiple Perl releases soak [options] [perl ...] --make=program override name of make program ($Config{make}) + --min=version use at least this version of perl --mmargs=options pass options to Makefile.PL (multiple --mmargs possible) --verbose be verbose diff --git a/ext/Devel/PPPort/t/MY_CXT.t b/ext/Devel/PPPort/t/MY_CXT.t index e9f1238307..77451a3a89 100644 --- a/ext/Devel/PPPort/t/MY_CXT.t +++ b/ext/Devel/PPPort/t/MY_CXT.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..3\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (3) { + load(); plan(tests => 3); } } diff --git a/ext/Devel/PPPort/t/SvPV.t b/ext/Devel/PPPort/t/SvPV.t index c684f943de..f66b9e5506 100644 --- a/ext/Devel/PPPort/t/SvPV.t +++ b/ext/Devel/PPPort/t/SvPV.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..2\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (2) { + load(); plan(tests => 2); } } diff --git a/ext/Devel/PPPort/t/SvREFCNT.t b/ext/Devel/PPPort/t/SvREFCNT.t new file mode 100644 index 0000000000..576665795c --- /dev/null +++ b/ext/Devel/PPPort/t/SvREFCNT.t @@ -0,0 +1,42 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/SvREFCNT 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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (14) { + load(); + plan(tests => 14); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +for (Devel::PPPort::SvREFCNT()) { + ok(defined $_ and $_); +} + diff --git a/ext/Devel/PPPort/t/Sv_set.t b/ext/Devel/PPPort/t/Sv_set.t index cb68641eee..9b587e2948 100644 --- a/ext/Devel/PPPort/t/Sv_set.t +++ b/ext/Devel/PPPort/t/Sv_set.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..5\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (5) { + load(); plan(tests => 5); } } diff --git a/ext/Devel/PPPort/t/call.t b/ext/Devel/PPPort/t/call.t index ffcfcc4b2d..ca19e1df2c 100644 --- a/ext/Devel/PPPort/t/call.t +++ b/ext/Devel/PPPort/t/call.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..44\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (44) { + load(); plan(tests => 44); } } diff --git a/ext/Devel/PPPort/t/cop.t b/ext/Devel/PPPort/t/cop.t index 1bcc9996e3..dad756d5da 100644 --- a/ext/Devel/PPPort/t/cop.t +++ b/ext/Devel/PPPort/t/cop.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..2\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (2) { + load(); plan(tests => 2); } } diff --git a/ext/Devel/PPPort/t/exception.t b/ext/Devel/PPPort/t/exception.t index b66f146f82..ec6b2345eb 100644 --- a/ext/Devel/PPPort/t/exception.t +++ b/ext/Devel/PPPort/t/exception.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..7\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (7) { + load(); plan(tests => 7); } } diff --git a/ext/Devel/PPPort/t/grok.t b/ext/Devel/PPPort/t/grok.t index 8766b353d6..68af0e6735 100644 --- a/ext/Devel/PPPort/t/grok.t +++ b/ext/Devel/PPPort/t/grok.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..10\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (10) { + load(); plan(tests => 10); } } diff --git a/ext/Devel/PPPort/t/limits.t b/ext/Devel/PPPort/t/limits.t index 1ccb8b1df0..00496510db 100644 --- a/ext/Devel/PPPort/t/limits.t +++ b/ext/Devel/PPPort/t/limits.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..4\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (4) { + load(); plan(tests => 4); } } diff --git a/ext/Devel/PPPort/t/mPUSH.t b/ext/Devel/PPPort/t/mPUSH.t index 66c62f9b61..36ae697373 100644 --- a/ext/Devel/PPPort/t/mPUSH.t +++ b/ext/Devel/PPPort/t/mPUSH.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..8\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (8) { + load(); plan(tests => 8); } } diff --git a/ext/Devel/PPPort/t/magic.t b/ext/Devel/PPPort/t/magic.t index 81c257d45f..dbc6630ea9 100644 --- a/ext/Devel/PPPort/t/magic.t +++ b/ext/Devel/PPPort/t/magic.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..13\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (13) { + load(); plan(tests => 13); } } diff --git a/ext/Devel/PPPort/t/memory.t b/ext/Devel/PPPort/t/memory.t index a1b574dda2..c25744c4da 100644 --- a/ext/Devel/PPPort/t/memory.t +++ b/ext/Devel/PPPort/t/memory.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..1\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (1) { + load(); plan(tests => 1); } } diff --git a/ext/Devel/PPPort/t/misc.t b/ext/Devel/PPPort/t/misc.t index 711b547604..6171ef2eea 100644 --- a/ext/Devel/PPPort/t/misc.t +++ b/ext/Devel/PPPort/t/misc.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..42\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (42) { + load(); plan(tests => 42); } } diff --git a/ext/Devel/PPPort/t/newCONSTSUB.t b/ext/Devel/PPPort/t/newCONSTSUB.t index 3d8762349c..60bfab83f1 100644 --- a/ext/Devel/PPPort/t/newCONSTSUB.t +++ b/ext/Devel/PPPort/t/newCONSTSUB.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..3\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (3) { + load(); plan(tests => 3); } } diff --git a/ext/Devel/PPPort/t/newRV.t b/ext/Devel/PPPort/t/newRV.t index e5baf9e894..98167be6fe 100644 --- a/ext/Devel/PPPort/t/newRV.t +++ b/ext/Devel/PPPort/t/newRV.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..2\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (2) { + load(); plan(tests => 2); } } diff --git a/ext/Devel/PPPort/t/podtest.t b/ext/Devel/PPPort/t/podtest.t new file mode 100644 index 0000000000..a5b097c827 --- /dev/null +++ b/ext/Devel/PPPort/t/podtest.t @@ -0,0 +1,65 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/podtest 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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (0) { + load(); + plan(tests => 0); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +my @pods = qw( HACKERS PPPort.pm ppport.h ); + +# Try loading Test::Pod +eval q{ + use Test::Pod; + $Test::Pod::VERSION >= 0.95 + or die "Test::Pod version only $Test::Pod::VERSION"; + import Test::Pod tests => scalar @pods; +}; + +my $TP = $@ eq ''; + +unless ($TP) { + load(); + plan(tests => scalar @pods); +} + +for (@pods) { + print "# checking $_\n"; + if ($TP) { + pod_file_ok($_); + } + else { + skip("skip: Test::Pod >= 0.95 required", 0); + } +} + diff --git a/ext/Devel/PPPort/t/ppphtest.t b/ext/Devel/PPPort/t/ppphtest.t index 4dc7f48cb1..02c0619031 100644 --- a/ext/Devel/PPPort/t/ppphtest.t +++ b/ext/Devel/PPPort/t/ppphtest.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..202\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (202) { + load(); plan(tests => 202); } } diff --git a/ext/Devel/PPPort/t/pvs.t b/ext/Devel/PPPort/t/pvs.t index dc925c3a86..ea250016c3 100644 --- a/ext/Devel/PPPort/t/pvs.t +++ b/ext/Devel/PPPort/t/pvs.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..7\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (7) { + load(); plan(tests => 7); } } diff --git a/ext/Devel/PPPort/t/snprintf.t b/ext/Devel/PPPort/t/snprintf.t index f70f71ff87..9c2c6b16f1 100644 --- a/ext/Devel/PPPort/t/snprintf.t +++ b/ext/Devel/PPPort/t/snprintf.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..2\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (2) { + load(); plan(tests => 2); } } diff --git a/ext/Devel/PPPort/t/sv_xpvf.t b/ext/Devel/PPPort/t/sv_xpvf.t index 33e203dde9..5c827d3da1 100644 --- a/ext/Devel/PPPort/t/sv_xpvf.t +++ b/ext/Devel/PPPort/t/sv_xpvf.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..9\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (9) { + load(); plan(tests => 9); } } diff --git a/ext/Devel/PPPort/t/testutil.pl b/ext/Devel/PPPort/t/testutil.pl index a4879d842b..4fc7d667a6 100644 --- a/ext/Devel/PPPort/t/testutil.pl +++ b/ext/Devel/PPPort/t/testutil.pl @@ -1,5 +1,21 @@ { my $__ntest; + my $__total; + + sub plan { + @_ == 2 or die "usage: plan(tests => count)"; + my $what = shift; + $what eq 'tests' or die "cannot plan anything but tests"; + $__total = shift; + defined $__total && $__total > 0 or die "need a positive number of tests"; + print "1..$__total\n"; + } + + sub skip { + my $reason = shift; + ++$__ntest; + print "ok $__ntest # skip: $reason\n" + } sub ok ($;$$) { local($\,$,); diff --git a/ext/Devel/PPPort/t/threads.t b/ext/Devel/PPPort/t/threads.t index 7243d8dda6..2e9f896483 100644 --- a/ext/Devel/PPPort/t/threads.t +++ b/ext/Devel/PPPort/t/threads.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..2\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (2) { + load(); plan(tests => 2); } } diff --git a/ext/Devel/PPPort/t/uv.t b/ext/Devel/PPPort/t/uv.t index 1272be7733..1d5ae2b458 100644 --- a/ext/Devel/PPPort/t/uv.t +++ b/ext/Devel/PPPort/t/uv.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..10\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (10) { + load(); plan(tests => 10); } } diff --git a/ext/Devel/PPPort/t/variables.t b/ext/Devel/PPPort/t/variables.t index 8a0dafe244..54a9fd69b4 100644 --- a/ext/Devel/PPPort/t/variables.t +++ b/ext/Devel/PPPort/t/variables.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..1\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (1) { + load(); plan(tests => 1); } } diff --git a/ext/Devel/PPPort/t/warn.t b/ext/Devel/PPPort/t/warn.t index 2607bf6ae0..8dd06bf98f 100644 --- a/ext/Devel/PPPort/t/warn.t +++ b/ext/Devel/PPPort/t/warn.t @@ -21,12 +21,13 @@ BEGIN { unshift @INC, 't'; } - eval "use Test"; - if ($@) { - require 'testutil.pl'; - print "1..5\n"; + sub load { + eval "use Test"; + require 'testutil.pl' if $@; } - else { + + if (5) { + load(); plan(tests => 5); } } |