Upgrade to Devel::PPPort 3.08_02

p4raw-id: //depot/perl@28267

diff --git a/MANIFEST b/MANIFEST
index deaa8ed..91f1ced 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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 6654bb0..458bc22 100755 (executable)
--- 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 df6d9c9..9b56c56 100644 (file)
--- 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 b658e89..4757b56 100644 (file)
--- 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 c6a3f8b..cbe65b2 100644 (file)
--- 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 6214d6c..344ef9f 100644 (file)
--- 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 98ef486..24889b2 100644 (file)
--- 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 337e217..09cde0e 100644 (file)
--- 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 eca5e86..47cb53d 100644 (file)
--- 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 dac19c7..bc12ba1 100644 (file)
--- 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 (file)
index 0000000..b9360fc
--- /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 8e2eb3d..2117893 100644 (file)
--- 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 17a81e7..ab4b7b9 100644 (file)
--- 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 (file)
index 0000000..c4f0130
--- /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 13d5b54..62dac9b 100644 (file)
--- 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 76efe7b..0b79cc0 100644 (file)
--- 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 83fb6e8..b4e3d3c 100644 (file)
--- 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 78a700d..2451e81 100644 (file)
--- 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 7b7ffe7..b0ee503 100644 (file)
--- 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 e9f1238..77451a3 100644 (file)
--- 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 c684f94..f66b9e5 100644 (file)
--- 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 (file)
index 0000000..5766657
--- /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 cb68641..9b587e2 100644 (file)
--- 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 ffcfcc4..ca19e1d 100644 (file)
--- 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 1bcc999..dad756d 100644 (file)
--- 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 b66f146..ec6b234 100644 (file)
--- 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 8766b35..68af0e6 100644 (file)
--- 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 1ccb8b1..0049651 100644 (file)
--- 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 66c62f9..36ae697 100644 (file)
--- 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 81c257d..dbc6630 100644 (file)
--- 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 a1b574d..c25744c 100644 (file)
--- 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 711b547..6171ef2 100644 (file)
--- 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 3d87623..60bfab8 100644 (file)
--- 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 e5baf9e..98167be 100644 (file)
--- 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 (file)
index 0000000..a5b097c
--- /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 4dc7f48..02c0619 100644 (file)
--- 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 dc925c3..ea25001 100644 (file)
--- 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 f70f71f..9c2c6b1 100644 (file)
--- 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 33e203d..5c827d3 100644 (file)
--- 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 a4879d8..4fc7d66 100644 (file)
--- 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 7243d8d..2e9f896 100644 (file)
--- 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 1272be7..1d5ae2b 100644 (file)
--- 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 8a0dafe..54a9fd6 100644 (file)
--- 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 2607bf6..8dd06bf 100644 (file)
--- 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);
   }
 }