import perl 5.10.1

36 files changed, 1538 insertions, 8320 deletions

diff --git a/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm b/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm
index 731dc111176..2fced312f2e 100644
--- a/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm
+++ b/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm
@@ -3,20 +3,20 @@
 
 package Devel::Peek;
 
-$VERSION = '1.16';
+$VERSION = '1.04';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
 require Exporter;
-require XSLoader;
+use XSLoader ();
 
 @ISA = qw(Exporter);
 @EXPORT = qw(Dump mstat DeadCode DumpArray DumpWithOP DumpProg
 	     fill_mstats mstats_fillhash mstats2hash runops_debug debug_flags);
-@EXPORT_OK = qw(SvREFCNT CvGV);
+@EXPORT_OK = qw(SvREFCNT SvREFCNT_inc SvREFCNT_dec CvGV);
 %EXPORT_TAGS = ('ALL' => [@EXPORT, @EXPORT_OK]);
 
-XSLoader::load();
+XSLoader::load 'Devel::Peek';
 
 sub import {
   my $c = shift;
@@ -76,8 +76,6 @@ Devel::Peek - A data debugging tool for the XS programmer
         use Devel::Peek;
         Dump( $a );
         Dump( $a, 5 );
-        Dump( @a );
-        Dump( %h );
         DumpArray( 5, $a, $b, ... );
 	mstat "Point 5";
 
@@ -100,18 +98,12 @@ Devel::Peek supplies a C<Dump()> function which can dump a raw Perl
 datatype, and C<mstat("marker")> function to report on memory usage
 (if perl is compiled with corresponding option).  The function
 DeadCode() provides statistics on the data "frozen" into inactive
-C<CV>.  Devel::Peek also supplies C<SvREFCNT()> which can query reference
+C<CV>.  Devel::Peek also supplies C<SvREFCNT()>, C<SvREFCNT_inc()>, and
+C<SvREFCNT_dec()> which can query, increment, and decrement reference
 counts on SVs.  This document will take a passive, and safe, approach
 to data debugging and for that it will describe only the C<Dump()>
 function.
 
-The C<Dump()> function takes one or two arguments: something to dump, and
-an optional limit for recursion and array elements (default is 4).  The
-first argument is evaluted in rvalue scalar context, with exceptions for
-@array and %hash, which dump the array or hash itself.  So C<Dump @array>
-works, as does C<Dump $foo>.  And C<Dump pos> will call C<pos> in rvalue
-context, whereas C<Dump ${\pos}> will call it in lvalue context.
-
 Function C<DumpArray()> allows dumping of multiple values (useful when you
 need to analyze returns of functions).
 
@@ -147,24 +139,22 @@ When perl is compiled with support for memory footprint debugging
 
 Use mstat() function to emit a memory state statistic to the terminal.
 For more information on the format of output of mstat() see
-L<perldebguts/Using $ENV{PERL_DEBUG_MSTATS}>.
+L<perldebguts/Using C<$ENV{PERL_DEBUG_MSTATS}>>.
 
 Three additional functions allow access to this statistic from Perl.
 First, use C<mstats_fillhash(%hash)> to get the information contained
 in the output of mstat() into %hash. The field of this hash are
 
-  minbucket nbuckets sbrk_good sbrk_slack sbrked_remains sbrks
-  start_slack topbucket topbucket_ev topbucket_odd total total_chain
-  total_sbrk totfree
+  minbucket nbuckets sbrk_good sbrk_slack sbrked_remains sbrks start_slack
+  topbucket topbucket_ev topbucket_odd total total_chain total_sbrk totfree
 
 Two additional fields C<free>, C<used> contain array references which
 provide per-bucket count of free and used chunks.  Two other fields
 C<mem_size>, C<available_size> contain array references which provide
 the information about the allocated size and usable size of chunks in
-each bucket.  Again, see L<perldebguts/Using $ENV{PERL_DEBUG_MSTATS}>
+each bucket.  Again, see L<perldebguts/Using C<$ENV{PERL_DEBUG_MSTATS}>>
 for details.
 
-
 Keep in mind that only the first several "odd-numbered" buckets are
 used, so the information on size of the "odd-numbered" buckets which are
 not used is probably meaningless.
@@ -221,32 +211,29 @@ expect to see it well-thumbed.
 Let's begin by looking a simple scalar which is holding a string.
 
         use Devel::Peek;
-        $a = 42; $a = "hello";
+        $a = "hello";
         Dump $a;
 
 The output:
 
-        SV = PVIV(0xbc288) at 0xbe9a8
+        SV = PVIV(0xbc288)
           REFCNT = 1
           FLAGS = (POK,pPOK)
-          IV = 42
+          IV = 0
           PV = 0xb2048 "hello"\0
           CUR = 5
-          LEN = 8
+          LEN = 6
 
-This says C<$a> is an SV, a scalar.  The scalar type is a PVIV, which is
-capable of holding an integer (IV) and/or a string (PV) value. The scalar's
-head is allocated at address 0xbe9a8, while the body is at 0xbc288.
+This says C<$a> is an SV, a scalar.  The scalar is a PVIV, a string.
 Its reference count is 1.  It has the C<POK> flag set, meaning its
 current PV field is valid.  Because POK is set we look at the PV item
 to see what is in the scalar.  The \0 at the end indicate that this
 PV is properly NUL-terminated.
-Note that the IV field still contains its old numeric value, but because
-FLAGS doesn't have IOK set, we must ignore the IV item.
-CUR indicates the number of characters in the PV.  LEN indicates the
-number of bytes allocated for the PV (at least one more than CUR, because
-LEN includes an extra byte for the end-of-string marker, then usually
-rounded up to some efficient allocation unit).
+If the FLAGS had been IOK we would look
+at the IV item.  CUR indicates the number of characters in the PV.
+LEN indicates the number of bytes requested for the PV (one more than
+CUR, in this case, because LEN includes an extra byte for the
+end-of-string marker).
 
 =head2 A simple scalar number
 
@@ -258,7 +245,7 @@ If the scalar contains a number the raw SV will be leaner.
 
 The output:
 
-        SV = IV(0xbc818) at 0xbe9a8
+        SV = IV(0xbc818)
           REFCNT = 1
           FLAGS = (IOK,pIOK)
           IV = 42
@@ -279,7 +266,7 @@ If the scalar from the previous example had an extra reference:
 
 The output:
 
-        SV = IV(0xbe860) at 0xbe9a8
+        SV = IV(0xbe860)
           REFCNT = 2
           FLAGS = (IOK,pIOK)
           IV = 42
@@ -299,25 +286,24 @@ This shows what a reference looks like when it references a simple scalar.
 
 The output:
 
-        SV = IV(0xf041c) at 0xbe9a0
+        SV = RV(0xf041c)
           REFCNT = 1
           FLAGS = (ROK)
           RV = 0xbab08
-          SV = IV(0xbe860) at 0xbe9a8
-            REFCNT = 2
-            FLAGS = (IOK,pIOK)
-            IV = 42
-
-Starting from the top, this says C<$b> is an SV.  The scalar is an IV,
-which is capable of holding an integer or reference value.
-It has the C<ROK> flag set, meaning it is a reference (rather than an
-integer or string).  Notice that Dump
+        SV = IV(0xbe860)
+          REFCNT = 2
+          FLAGS = (IOK,pIOK)
+          IV = 42
+
+Starting from the top, this says C<$b> is an SV.  The scalar is an RV, a
+reference.  It has the C<ROK> flag set, meaning it is a reference.  Because
+ROK is set we have an RV item rather than an IV or PV.  Notice that Dump
 follows the reference and shows us what C<$b> was referencing.  We see the
 same C<$a> that we found in the previous example.
 
 Note that the value of C<RV> coincides with the numbers we see when we
-stringify $b. The addresses inside IV() are addresses of
-C<X***> structures which hold the current state of an C<SV>. This
+stringify $b. The addresses inside RV() and IV() are addresses of
+C<X***> structure which holds the current state of an C<SV>. This
 address may change during lifetime of an SV.
 
 =head2 A reference to an array
@@ -330,25 +316,28 @@ This shows what a reference to an array looks like.
 
 The output:
 
-        SV = IV(0xc85998) at 0xc859a8
+        SV = RV(0xf041c)
           REFCNT = 1
           FLAGS = (ROK)
-          RV = 0xc70de8
-          SV = PVAV(0xc71e10) at 0xc70de8
-            REFCNT = 1
-            FLAGS = ()
-            ARRAY = 0xc7e820
-            FILL = 0
-            MAX = 0
-            ARYLEN = 0x0
-            FLAGS = (REAL)
-            Elt No. 0
-            SV = IV(0xc70f88) at 0xc70f98
-              REFCNT = 1
-              FLAGS = (IOK,pIOK)
-              IV = 42
-
-This says C<$a> is a reference (ROK), which points to
+          RV = 0xb2850
+        SV = PVAV(0xbd448)
+          REFCNT = 1
+          FLAGS = ()
+          IV = 0
+          NV = 0
+          ARRAY = 0xb2048
+          ALLOC = 0xb2048
+          FILL = 0
+          MAX = 0
+          ARYLEN = 0x0
+          FLAGS = (REAL)
+        Elt No. 0 0xb5658
+        SV = IV(0xbe860)
+          REFCNT = 1
+          FLAGS = (IOK,pIOK)
+          IV = 42
+
+This says C<$a> is an SV and that it is an RV.  That RV points to
 another SV which is a PVAV, an array.  The array has one element,
 element zero, which is another SV. The field C<FILL> above indicates
 the last element in the array, similar to C<$#$a>.
@@ -362,28 +351,31 @@ following.
 
 The output:
 
-        SV = IV(0x158c998) at 0x158c9a8
+        SV = RV(0xf041c)
           REFCNT = 1
           FLAGS = (ROK)
-          RV = 0x1577de8
-          SV = PVAV(0x1578e10) at 0x1577de8
-            REFCNT = 1
-            FLAGS = ()
-            ARRAY = 0x1585820
-            FILL = 1
-            MAX = 1
-            ARYLEN = 0x0
-            FLAGS = (REAL)
-            Elt No. 0
-            SV = IV(0x1577f88) at 0x1577f98
-              REFCNT = 1
-              FLAGS = (IOK,pIOK)
-              IV = 42
-            Elt No. 1
-            SV = IV(0x158be88) at 0x158be98
-              REFCNT = 1
-              FLAGS = (IOK,pIOK)
-              IV = 24
+          RV = 0xb2850
+        SV = PVAV(0xbd448)
+          REFCNT = 1
+          FLAGS = ()
+          IV = 0
+          NV = 0
+          ARRAY = 0xb2048
+          ALLOC = 0xb2048
+          FILL = 0
+          MAX = 0
+          ARYLEN = 0x0
+          FLAGS = (REAL)
+        Elt No. 0  0xb5658
+        SV = IV(0xbe860)
+          REFCNT = 1
+          FLAGS = (IOK,pIOK)
+          IV = 42
+        Elt No. 1  0xb5680
+        SV = IV(0xbe818)
+          REFCNT = 1
+          FLAGS = (IOK,pIOK)
+          IV = 24
 
 Note that C<Dump> will not report I<all> the elements in the array,
 only several first (depending on how deep it already went into the
@@ -399,13 +391,15 @@ The following shows the raw form of a reference to a hash.
 
 The output:
 
-	SV = IV(0x8177858) at 0x816a618
+	SV = RV(0x8177858) at 0x816a618
 	  REFCNT = 1
 	  FLAGS = (ROK)
 	  RV = 0x814fc10
 	  SV = PVHV(0x8167768) at 0x814fc10
 	    REFCNT = 1
 	    FLAGS = (SHAREKEYS)
+	    IV = 1
+	    NV = 0
 	    ARRAY = 0x816c5b8  (0:7, 1:1)
 	    hash quality = 100.0%
 	    KEYS = 1
@@ -420,7 +414,7 @@ The output:
 	      IV = 42
 
 This shows C<$a> is a reference pointing to an SV.  That SV is a PVHV, a
-hash. Fields RITER and EITER are used by C<L<perlfunc/each>>.
+hash. Fields RITER and EITER are used by C<L<each>>.
 
 The "quality" of a hash is defined as the total number of comparisons needed
 to access every element once, relative to the expected number needed for a
@@ -457,19 +451,19 @@ and a reference to that SV is placed on the XSUB stack.  So the output from
 an XSUB which uses something like the T_PTROBJ map might look something like
 this:
 
-        SV = IV(0xf381c) at 0xc859a8
+        SV = RV(0xf381c)
           REFCNT = 1
           FLAGS = (ROK)
           RV = 0xb8ad8
-          SV = PVMG(0xbb3c8) at 0xc859a0
-            REFCNT = 1
-            FLAGS = (OBJECT,IOK,pIOK)
-            IV = 729160
-            NV = 0
-            PV = 0
-            STASH = 0xc1d10       "CookBookB::Opaque"
-
-This shows that we have an SV which is a reference, which points at another
+        SV = PVMG(0xbb3c8)
+          REFCNT = 1
+          FLAGS = (OBJECT,IOK,pIOK)
+          IV = 729160
+          NV = 0
+          PV = 0
+          STASH = 0xc1d10       "CookBookB::Opaque"
+
+This shows that we have an SV which is an RV.  That RV points at another
 SV.  In this case that second SV is a PVMG, a blessed scalar.  Because it is
 blessed it has the C<OBJECT> flag set.  Note that an SV which holds a C
 pointer also has the C<IOK> flag set.  The C<STASH> is set to the package
@@ -478,40 +472,39 @@ name which this SV was blessed into.
 The output from an XSUB which uses something like the T_PTRREF map, which
 doesn't bless the object, might look something like this:
 
-        SV = IV(0xf381c) at 0xc859a8
+        SV = RV(0xf381c)
           REFCNT = 1
           FLAGS = (ROK)
           RV = 0xb8ad8
-          SV = PVMG(0xbb3c8) at 0xc859a0
-            REFCNT = 1
-            FLAGS = (IOK,pIOK)
-            IV = 729160
-            NV = 0
-            PV = 0
+        SV = PVMG(0xbb3c8)
+          REFCNT = 1
+          FLAGS = (IOK,pIOK)
+          IV = 729160
+          NV = 0
+          PV = 0
 
 =head2 A reference to a subroutine
 
 Looks like this:
 
-	SV = IV(0x24d2dd8) at 0x24d2de8
+	SV = RV(0x798ec)
 	  REFCNT = 1
 	  FLAGS = (TEMP,ROK)
-	  RV = 0x24e79d8
-	  SV = PVCV(0x24e5798) at 0x24e79d8
-	    REFCNT = 2
-	    FLAGS = ()
-	    COMP_STASH = 0x22c9c50	"main"
-	    START = 0x22eed60 ===> 0
-	    ROOT = 0x22ee490
-	    GVGV::GV = 0x22de9d8	"MY" :: "top_targets"
-	    FILE = "(eval 5)"
-	    DEPTH = 0
-	    FLAGS = 0x0
-	    OUTSIDE_SEQ = 93
-	    PADLIST = 0x22e9ed8
-	    PADNAME = 0x22e9ec0(0x22eed00) PAD = 0x22e9ea8(0x22eecd0)
-	    OUTSIDE = 0x22c9fb0 (MAIN)
-
+	  RV = 0x1d453c
+	SV = PVCV(0x1c768c)
+	  REFCNT = 2
+	  FLAGS = ()
+	  IV = 0
+	  NV = 0
+	  COMP_STASH = 0x31068  "main"
+	  START = 0xb20e0
+	  ROOT = 0xbece0
+	  XSUB = 0x0
+	  XSUBANY = 0
+	  GVGV::GV = 0x1d44e8   "MY" :: "top_targets"
+	  FILE = "(eval 5)"
+	  DEPTH = 0
+	  PADLIST = 0x1c9338
 
 This shows that 
 
@@ -520,7 +513,7 @@ This shows that
 =item *
 
 the subroutine is not an XSUB (since C<START> and C<ROOT> are
-non-zero, and C<XSUB> is not listed, and is thus null);
+non-zero, and C<XSUB> is zero);
 
 =item *
 
diff --git a/gnu/usr.bin/perl/ext/Devel-Peek/Peek.xs b/gnu/usr.bin/perl/ext/Devel-Peek/Peek.xs
index 679efa5d063..68584f73e0b 100644
--- a/gnu/usr.bin/perl/ext/Devel-Peek/Peek.xs
+++ b/gnu/usr.bin/perl/ext/Devel-Peek/Peek.xs
@@ -7,10 +7,11 @@ static bool
 _runops_debug(int flag)
 {
     dTHX;
-    const bool d = PL_runops == Perl_runops_debug;
+    const bool d = PL_runops == MEMBER_TO_FPTR(Perl_runops_debug);
 
     if (flag >= 0)
-	PL_runops = flag ? Perl_runops_debug : Perl_runops_standard;
+	PL_runops 
+	    = MEMBER_TO_FPTR(flag ? Perl_runops_debug : Perl_runops_standard);
     return d;
 }
 
@@ -23,7 +24,7 @@ DeadCode(pTHX)
     SV* sva;
     SV* sv;
     SV* ret = newRV_noinc((SV*)newAV());
-    SV* svend;
+    register SV* svend;
     int tm = 0, tref = 0, ts = 0, ta = 0, tas = 0;
 
     for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
@@ -31,8 +32,7 @@ DeadCode(pTHX)
 	for (sv = sva + 1; sv < svend; ++sv) {
 	    if (SvTYPE(sv) == SVt_PVCV) {
 		CV *cv = (CV*)sv;
-		PADLIST* padlist = CvPADLIST(cv);
-                AV *argav;
+		AV* padlist = CvPADLIST(cv), *argav;
 		SV** svp;
 		SV** pad;
 		int i = 0, j, levelm, totm = 0, levelref, totref = 0;
@@ -54,11 +54,10 @@ DeadCode(pTHX)
 		    PerlIO_printf(Perl_debug_log, "  busy\n");
 		    continue;
 		}
-		svp = (SV**) PadlistARRAY(padlist);
-		while (++i <= PadlistMAX(padlist)) { /* Depth. */
+		svp = AvARRAY(padlist);
+		while (++i <= AvFILL(padlist)) { /* Depth. */
 		    SV **args;
 		    
-		    if (!svp[i]) continue;
 		    pad = AvARRAY((AV*)svp[i]);
 		    argav = (AV*)pad[0];
 		    if (!argav || (SV*)argav == &PL_sv_undef) {
@@ -81,7 +80,6 @@ DeadCode(pTHX)
 			}
 		    }
 		    for (j = 1; j < AvFILL((AV*)svp[1]); j++) {	/* Vars. */
-			if (!pad[j]) continue;
 			if (SvROK(pad[j])) {
 			    levelref++;
 			    do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0);
@@ -111,7 +109,7 @@ DeadCode(pTHX)
 		    if (dumpit)
 			do_sv_dump(0, Perl_debug_log, (SV*)cv, 0, 2, 0, 0);
 		}
-		if (PadlistMAX(padlist) > 1) {
+		if (AvFILL(padlist) > 1) {
 		    PerlIO_printf(Perl_debug_log, "  total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n", 
 			    totref, totm, tots, tota, totas);
 		}
@@ -166,7 +164,7 @@ fill_mstats(SV *sv, int level)
 
     if (SvREADONLY(sv))
 	croak("Cannot modify a readonly value");
-    sv_grow(sv, sizeof(struct mstats_buffer)+1);
+    SvGROW(sv, sizeof(struct mstats_buffer)+1);
     _fill_mstats((struct mstats_buffer*)SvPVX(sv),level);
     SvCUR_set(sv, sizeof(struct mstats_buffer));
     *SvEND(sv) = '\0';
@@ -297,25 +295,18 @@ mstats2hash(SV *sv, SV *rv, int level)
 static void
 fill_mstats(SV *sv, int level)
 {
-    PERL_UNUSED_ARG(sv);
-    PERL_UNUSED_ARG(level);
     croak("Cannot report mstats without Perl malloc");
 }
 
 static void
 mstats_fillhash(SV *sv, int level)
 {
-    PERL_UNUSED_ARG(sv);
-    PERL_UNUSED_ARG(level);
     croak("Cannot report mstats without Perl malloc");
 }
 
 static void
 mstats2hash(SV *sv, SV *rv, int level)
 {
-    PERL_UNUSED_ARG(sv);
-    PERL_UNUSED_ARG(rv);
-    PERL_UNUSED_ARG(level);
     croak("Cannot report mstats without Perl malloc");
 }
 #endif	/* defined(MYMALLOC) */ 
@@ -324,103 +315,6 @@ mstats2hash(SV *sv, SV *rv, int level)
 	(SvROK(cv) && (SvTYPE(SvRV(cv))==SVt_PVCV)	\
 	 ? SvREFCNT_inc(CvGV((CV*)SvRV(cv))) : &PL_sv_undef)
 
-static void
-S_do_dump(pTHX_ SV *const sv, I32 lim)
-{
-    dVAR;
-    SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", 0);
-    const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
-    SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", 0);
-    const U16 save_dumpindent = PL_dumpindent;
-    PL_dumpindent = 2;
-    do_sv_dump(0, Perl_debug_log, sv, 0, lim,
-	       (bool)(dumpop && SvTRUE(dumpop)), pv_lim);
-    PL_dumpindent = save_dumpindent;
-}
-
-static OP *
-S_pp_dump(pTHX)
-{
-    dSP;
-    const I32 lim = PL_op->op_private == 2 ? (I32)POPi : 4;
-    dPOPss;
-    S_do_dump(aTHX_ sv, lim);
-    RETPUSHUNDEF;
-}
-
-static OP *
-S_ck_dump(pTHX_ OP *entersubop, GV *namegv, SV *cv)
-{
-    OP *aop, *prev, *first, *second = NULL;
-    BINOP *newop;
-
-    PERL_UNUSED_ARG(cv);
-
-    ck_entersub_args_proto(entersubop, namegv,
-			   newSVpvn_flags("$;$", 3, SVs_TEMP));
-
-    aop = cUNOPx(entersubop)->op_first;
-    if (!aop->op_sibling)
-	aop = cUNOPx(aop)->op_first;
-    prev = aop;
-    aop = aop->op_sibling;
-    while (PL_madskills && aop->op_type == OP_STUB) {
-	prev = aop;
-	aop = aop->op_sibling;
-    }
-    if (PL_madskills && aop->op_type == OP_NULL) {
-	first = ((UNOP*)aop)->op_first;
-	((UNOP*)aop)->op_first = NULL;
-	prev = aop;
-    }
-    else {
-	first = aop;
-	prev->op_sibling = first->op_sibling;
-    }
-    if (first->op_type == OP_RV2AV ||
-	first->op_type == OP_PADAV ||
-	first->op_type == OP_RV2HV ||
-	first->op_type == OP_PADHV
-    )
-	first->op_flags |= OPf_REF;
-    else
-	first->op_flags &= ~OPf_MOD;
-    aop = aop->op_sibling;
-    while (PL_madskills && aop->op_type == OP_STUB) {
-	prev = aop;
-	aop = aop->op_sibling;
-    }
-    if (!aop) {
-	/* It doesn’t really matter what we return here, as this only
-	   occurs after yyerror.  */
-	op_free(first);
-	return entersubop;
-    }
-
-    /* aop now points to the second arg if there is one, the cvop otherwise
-     */
-    if (aop->op_sibling) {
-	prev->op_sibling = aop->op_sibling;
-	second = aop;
-	second->op_sibling = NULL;
-    }
-    first->op_sibling = second;
-
-    op_free(entersubop);
-
-    NewOp(1234, newop, 1, BINOP);
-    newop->op_type   = OP_CUSTOM;
-    newop->op_ppaddr = S_pp_dump;
-    newop->op_first  = first;
-    newop->op_last   = second;
-    newop->op_private= second ? 2 : 1;
-    newop->op_flags  = OPf_KIDS|OPf_WANT_SCALAR;
-
-    return (OP *)newop;
-}
-
-static XOP my_xop;
-
 MODULE = Devel::Peek		PACKAGE = Devel::Peek
 
 void
@@ -444,18 +338,14 @@ SV *	sv
 I32	lim
 PPCODE:
 {
-    S_do_dump(aTHX_ sv, lim);
-}
-
-BOOT:
-{
-    CV * const cv = get_cvn_flags("Devel::Peek::Dump", 17, 0);
-    cv_set_call_checker(cv, S_ck_dump, (SV *)cv);
-
-    XopENTRY_set(&my_xop, xop_name, "Dump");
-    XopENTRY_set(&my_xop, xop_desc, "Dump");
-    XopENTRY_set(&my_xop, xop_class, OA_BINOP);
-    Perl_custom_op_register(aTHX_ S_pp_dump, &my_xop);
+    SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", 0);
+    const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
+    SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", 0);
+    const U16 save_dumpindent = PL_dumpindent;
+    PL_dumpindent = 2;
+    do_sv_dump(0, Perl_debug_log, sv, 0, lim,
+	       (bool)(dumpop && SvTRUE(dumpop)), pv_lim);
+    PL_dumpindent = save_dumpindent;
 }
 
 void
@@ -487,17 +377,31 @@ PPCODE:
 	op_dump(PL_main_root);
 }
 
-U32
+I32
 SvREFCNT(sv)
 SV *	sv
-PROTOTYPE: \[$@%&*]
-CODE:
-    SvGETMAGIC(sv);
-    if (!SvROK(sv))
-        croak_xs_usage(cv, "SCALAR");
-    RETVAL = SvREFCNT(SvRV(sv)) - 1; /* -1 because our ref doesn't count */
-OUTPUT:
-    RETVAL
+
+# PPCODE needed since otherwise sv_2mortal is inserted that will kill the value.
+
+SV *
+SvREFCNT_inc(sv)
+SV *	sv
+PPCODE:
+{
+    RETVAL = SvREFCNT_inc(sv);
+    PUSHs(RETVAL);
+}
+
+# PPCODE needed since by default it is void
+
+void
+SvREFCNT_dec(sv)
+SV *	sv
+PPCODE:
+{
+    SvREFCNT_dec(sv);
+    PUSHs(sv);
+}
 
 SV *
 DeadCode()
diff --git a/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t b/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t
index 2cfd8a52059..a089154eeb8 100755
--- a/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t
+++ b/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t
@@ -1,22 +1,21 @@
 #!./perl -T
 
 BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) {
         print "1..0 # Skip: Devel::Peek was not built\n";
         exit 0;
     }
-    {
-    package t;
-       my $core = !!$ENV{PERL_CORE};
-       require($core ? '../../t/test.pl' : './t/test.pl');
-    }
 }
 
-use Test::More;
+BEGIN { require "./test.pl"; }
 
 use Devel::Peek;
 
+plan(52);
+
 our $DEBUG = 0;
 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
 
@@ -30,30 +29,15 @@ Good    @>>>>>
 $::mmmm
 .
 
-use constant thr => $Config{useithreads};
-
 sub do_test {
     my $todo = $_[3];
     my $repeat_todo = $_[4];
     my $pattern = $_[2];
-    my $do_eval = $_[5];
     if (open(OUT,">peek$$")) {
 	open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
-        if ($do_eval) {
-            my $sub = eval "sub { Dump $_[1] }";
-            $sub->();
-            print STDERR "*****\n";
-            # second dump to compare with the first to make sure nothing
-            # changed.
-            $sub->();
-        }
-        else {
-            Dump($_[1]);
-            print STDERR "*****\n";
-            # second dump to compare with the first to make sure nothing
-            # changed.
-            Dump($_[1]);
-        }
+	Dump($_[1]);
+        print STDERR "*****\n";
+        Dump($_[1]); # second dump to compare with the first to make sure nothing changed.
 	open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
 	close(OUT);
 	if (open(IN, "peek$$")) {
@@ -68,7 +52,7 @@ sub do_test {
 	    # things like $IVNV gave the illusion that the string passed in was
 	    # a regexp into which variables were interpolated, but this wasn't
 	    # actually true as those 'variables' actually also ate the
-	    # whitespace on the line. So it seems better to mark lines that
+	    # whitspace on the line. So it seems better to mark lines that
 	    # need to be eliminated. I considered (?# ... ) and (?{ ... }),
 	    # but whilst embedded code or comment syntax would keep it as a
 	    # legitimate regexp, it still isn't true. Seems easier and clearer
@@ -77,7 +61,7 @@ sub do_test {
 	    # Could do this is in a s///mge but seems clearer like this:
 	    $pattern = join '', map {
 		# If we identify the version condition, take *it* out whatever
-		s/\s*# (\$].*)$//
+		s/\s*# (\$] [<>]=? 5\.\d\d\d)$//
 		    ? (eval $1 ? $_ : '')
 		    : $_ # Didn't match, so this line is in
 	    } split /^/, $pattern;
@@ -91,19 +75,14 @@ sub do_test {
 	    $pattern =~ s/\$RV/
 		($] < 5.011) ? 'RV' : 'IV';
 	    /mge;
-	    $pattern =~ s/^\h+COW_REFCNT = .*\n//mg
-		if $Config{ccflags} =~
-			/-DPERL_(?:OLD_COPY_ON_WRITE|NO_COW)/
-			    || $] < 5.019003;
+
 	    print $pattern, "\n" if $DEBUG;
 	    my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
 	    print $dump, "\n"    if $DEBUG;
-	    like( $dump, qr/\A$pattern\Z/ms, $_[0])
-	      or note("line " . (caller)[2]);
+	    like( $dump, qr/\A$pattern\Z/ms );
 
             local $TODO = $repeat_todo;
-            is($dump2, $dump, "$_[0] (unchanged by dump)")
-	      or note("line " . (caller)[2]);
+            is($dump2, $dump);
 
 	    close(IN);
 
@@ -125,43 +104,40 @@ END {
     1 while unlink("peek$$");
 }
 
-do_test('assignment of immediate constant (string)',
+do_test( 1,
 	$a = "foo",
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
+  FLAGS = \\(POK,pPOK\\)
   PV = $ADDR "foo"\\\0
   CUR = 3
-  LEN = \\d+
-  COW_REFCNT = 1
-');
+  LEN = \\d+'
+       );
 
-do_test('immediate constant (string)',
+do_test( 2,
         "bar",
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
+  FLAGS = \\(.*POK,READONLY,pPOK\\)
   PV = $ADDR "bar"\\\0
   CUR = 3
-  LEN = \\d+
-  COW_REFCNT = 0
-');
+  LEN = \\d+');
 
-do_test('assignment of immediate constant (integer)',
+do_test( 3,
         $b = 123,
 'SV = IV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(IOK,pIOK\\)
   IV = 123');
 
-do_test('immediate constant (integer)',
+do_test( 4,
         456,
 'SV = IV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(.*IOK,READONLY,pIOK\\)
   IV = 456');
 
-do_test('assignment of immediate constant (integer)',
+do_test( 5,
         $c = 456,
 'SV = IV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -173,21 +149,17 @@ do_test('assignment of immediate constant (integer)',
 # maths is done in floating point always, and this scalar will be an NV.
 # ([NI]) captures the type, referred to by \1 in this regexp and $type for
 # building subsequent regexps.
-my $type = do_test('result of addition',
+my $type = do_test( 6,
         $c + $d,
 'SV = ([NI])V\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\(PADTMP,\1OK,p\1OK\\)		# $] < 5.019003
-  FLAGS = \\(\1OK,p\1OK\\)			# $] >=5.019003
+  FLAGS = \\(PADTMP,\1OK,p\1OK\\)
   \1V = 456');
 
 ($d = "789") += 0.1;
 
-do_test('floating point value',
+do_test( 7,
        $d,
-       $] < 5.019003
-        || $Config{ccflags} =~ /-DPERL_(?:NO_COW|OLD_COPY_ON_WRITE)/
-       ?
 'SV = PVNV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(NOK,pNOK\\)
@@ -195,29 +167,22 @@ do_test('floating point value',
   NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
   PV = $ADDR "789"\\\0
   CUR = 3
-  LEN = \\d+'
-       :
-'SV = PVNV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(NOK,pNOK\\)
-  IV = \d+
-  NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
-  PV = 0');
+  LEN = \\d+');
 
-do_test('integer constant',
+do_test( 8,
         0xabcd,
 'SV = IV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(.*IOK,READONLY,pIOK\\)
   IV = 43981');
 
-do_test('undef',
+do_test( 9,
         undef,
 'SV = NULL\\(0x0\\) at $ADDR
-  REFCNT = \d+
-  FLAGS = \\(READONLY\\)');
+  REFCNT = 1
+  FLAGS = \\(\\)');
 
-do_test('reference to scalar',
+do_test(10,
         \$a,
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -225,12 +190,10 @@ do_test('reference to scalar',
   RV = $ADDR
   SV = PV\\($ADDR\\) at $ADDR
     REFCNT = 2
-    FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
+    FLAGS = \\(POK,pPOK\\)
     PV = $ADDR "foo"\\\0
     CUR = 3
-    LEN = \\d+
-    COW_REFCNT = 1
-');
+    LEN = \\d+');
 
 my $c_pattern;
 if ($type eq 'N') {
@@ -248,7 +211,7 @@ if ($type eq 'N') {
       FLAGS = \\(IOK,pIOK\\)
       IV = 456';
 }
-do_test('reference to array',
+do_test(11,
        [$b,$c],
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -271,14 +234,14 @@ do_test('reference to array',
       IV = 123
     Elt No. 1' . $c_pattern);
 
-do_test('reference to hash',
+do_test(12,
        {$b=>$c},
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = [12]
+    REFCNT = 1
     FLAGS = \\(SHAREKEYS\\)
     IV = 1					# $] < 5.009
     NV = $FLOAT					# $] < 5.009
@@ -287,12 +250,13 @@ do_test('reference to hash',
     KEYS = 1
     FILL = 1
     MAX = 7
+    RITER = -1
+    EITER = 0x0
     Elt "123" HASH = $ADDR' . $c_pattern,
 	'',
-	$] > 5.009 && $] < 5.015
-	 && 'The hash iterator used in dump.c sets the OOK flag');
+	$] > 5.009 && 'The hash iterator used in dump.c sets the OOK flag');
 
-do_test('reference to anon sub with empty prototype',
+do_test(13,
         sub(){@_},
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -300,8 +264,7 @@ do_test('reference to anon sub with empty prototype',
   RV = $ADDR
   SV = PVCV\\($ADDR\\) at $ADDR
     REFCNT = 2
-    FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\) # $] < 5.015 || !thr
-    FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC,DYNFILE\\) # $] >= 5.015 && thr
+    FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
     IV = 0					# $] < 5.009
     NV = 0					# $] < 5.009
     PROTOTYPE = ""
@@ -316,14 +279,13 @@ do_test('reference to anon sub with empty prototype',
     MUTEXP = $ADDR
     OWNER = $ADDR)?
     FLAGS = 0x404				# $] < 5.009
-    FLAGS = 0x490		# $] >= 5.009 && ($] < 5.015 || !thr)
-    FLAGS = 0x1490				# $] >= 5.015 && thr
+    FLAGS = 0x90				# $] >= 5.009
     OUTSIDE_SEQ = \\d+
     PADLIST = $ADDR
     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
     OUTSIDE = $ADDR \\(MAIN\\)');
 
-do_test('reference to named subroutine without prototype',
+do_test(14,
         \&do_test,
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -331,8 +293,7 @@ do_test('reference to named subroutine without prototype',
   RV = $ADDR
   SV = PVCV\\($ADDR\\) at $ADDR
     REFCNT = (3|4)
-    FLAGS = \\((?:HASEVAL)?\\)			# $] < 5.015 || !thr
-    FLAGS = \\(DYNFILE(?:,HASEVAL)?\\)		# $] >= 5.015 && thr
+    FLAGS = \\(\\)
     IV = 0					# $] < 5.009
     NV = 0					# $] < 5.009
     COMP_STASH = $ADDR\\t"main"
@@ -342,19 +303,16 @@ do_test('reference to named subroutine without prototype',
     XSUBANY = 0					# $] < 5.009
     GVGV::GV = $ADDR\\t"main" :: "do_test"
     FILE = ".*\\b(?i:peek\\.t)"
-    DEPTH = 1(?:
-    MUTEXP = $ADDR
-    OWNER = $ADDR)?
-    FLAGS = 0x(?:400)?0				# $] < 5.015 || !thr
-    FLAGS = 0x[145]000				# $] >= 5.015 && thr
+    DEPTH = 1
+(?:    MUTEXP = $ADDR
+    OWNER = $ADDR
+)?    FLAGS = 0x0
     OUTSIDE_SEQ = \\d+
     PADLIST = $ADDR
     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
        \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$todo"
        \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$repeat_todo"
        \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
-       \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$do_eval"
-      \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$sub"
       \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG"			# $] < 5.009
       \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0	# $] >= 5.009
       \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
@@ -362,78 +320,22 @@ do_test('reference to named subroutine without prototype',
     OUTSIDE = $ADDR \\(MAIN\\)');
 
 if ($] >= 5.011) {
-# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
-do_test('reference to regexp',
+do_test(15,
         qr(tic),
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = REGEXP\\($ADDR\\) at $ADDR
-    REFCNT = 1
-    FLAGS = \\(OBJECT,POK,FAKE,pPOK\\)		# $] < 5.017006
-    FLAGS = \\(OBJECT,FAKE\\)			# $] >= 5.017006
-    PV = $ADDR "\\(\\?\\^:tic\\)"
-    CUR = 8
-    LEN = 0					# $] < 5.017006
-    STASH = $ADDR\\t"Regexp"'
-. ($] < 5.013 ? '' :
-'
-    COMPFLAGS = 0x0 \(\)
-    EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-(?:    ENGINE = $ADDR \(STANDARD\)
-)?    INTFLAGS = 0x0(?: \(\))?
-    NPARENS = 0
-    LASTPAREN = 0
-    LASTCLOSEPAREN = 0
-    MINLEN = 3
-    MINLENRET = 3
-    GOFS = 0
-    PRE_PREFIX = 4
-    SUBLEN = 0
-    SUBOFFSET = 0
-    SUBCOFFSET = 0
-    SUBBEG = 0x0
-(?:    ENGINE = $ADDR
-)?    MOTHER_RE = $ADDR'
-. ($] < 5.019003 ? '' : '
-    SV = REGEXP\($ADDR\) at $ADDR
-      REFCNT = 2
-      FLAGS = \(\)
-      PV = $ADDR "\(\?\^:tic\)"
-      CUR = 8
-      COMPFLAGS = 0x0 \(\)
-      EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-(?:      ENGINE = $ADDR \(STANDARD\)
-)?      INTFLAGS = 0x0(?: \(\))?
-      NPARENS = 0
-      LASTPAREN = 0
-      LASTCLOSEPAREN = 0
-      MINLEN = 3
-      MINLENRET = 3
-      GOFS = 0
-      PRE_PREFIX = 4
-      SUBLEN = 0
-      SUBOFFSET = 0
-      SUBCOFFSET = 0
-      SUBBEG = 0x0
-(?:    ENGINE = $ADDR
-)?      MOTHER_RE = 0x0
-      PAREN_NAMES = 0x0
-      SUBSTRS = $ADDR
-      PPRIVATE = $ADDR
-      OFFS = $ADDR
-      QR_ANONCV = 0x0(?:
-      SAVED_COPY = 0x0)?') . '
-    PAREN_NAMES = 0x0
-    SUBSTRS = $ADDR
-    PPRIVATE = $ADDR
-    OFFS = $ADDR
-    QR_ANONCV = 0x0(?:
-    SAVED_COPY = 0x0)?'
-));
+    REFCNT = 2
+    FLAGS = \\(OBJECT,POK,pPOK\\)
+    IV = 0
+    PV = $ADDR "\\(\\?-xism:tic\\)"\\\0
+    CUR = 12
+    LEN = \\d+
+    STASH = $ADDR\\t"Regexp"');
 } else {
-do_test('reference to regexp',
+do_test(15,
         qr(tic),
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -449,19 +351,19 @@ do_test('reference to regexp',
       MG_VIRTUAL = $ADDR
       MG_TYPE = PERL_MAGIC_qr\(r\)
       MG_OBJ = $ADDR
-        PAT = "\(\?^:tic\)"			# $] >= 5.009
+        PAT = "\(\?-xism:tic\)"			# $] >= 5.009
         REFCNT = 2				# $] >= 5.009
     STASH = $ADDR\\t"Regexp"');
 }
 
-do_test('reference to blessed hash',
+do_test(16,
         (bless {}, "Tac"),
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = [12]
+    REFCNT = 1
     FLAGS = \\(OBJECT,SHAREKEYS\\)
     IV = 0					# $] < 5.009
     NV = 0					# $] < 5.009
@@ -469,14 +371,13 @@ do_test('reference to blessed hash',
     ARRAY = 0x0
     KEYS = 0
     FILL = 0
-    MAX = 7', '',
-	$] > 5.009
-	? $] >= 5.015
-	     ? 0
-	     : 'The hash iterator used in dump.c sets the OOK flag'
+    MAX = 7
+    RITER = -1
+    EITER = 0x0', '',
+	$] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
 	: "Something causes the HV's array to become allocated");
 
-do_test('typeglob',
+do_test(17,
 	*a,
 'SV = PVGV\\($ADDR\\) at $ADDR
   REFCNT = 5
@@ -508,40 +409,34 @@ do_test('typeglob',
     EGV = $ADDR\\t"a"');
 
 if (ord('A') == 193) {
-do_test('string with Unicode',
+do_test(18,
 	chr(256).chr(0).chr(512),
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)	# $] < 5.019003
-  FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\)	# $] >=5.019003
+  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
   PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
   CUR = 5
-  LEN = \\d+
-  COW_REFCNT = 1					# $] < 5.019007
-');
+  LEN = \\d+');
 } else {
-do_test('string with Unicode',
+do_test(18,
 	chr(256).chr(0).chr(512),
 'SV = PV\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)	# $] < 5.019003
-  FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\)	# $] >=5.019003
+  FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\)
   PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
   CUR = 5
-  LEN = \\d+
-  COW_REFCNT = 1					# $] < 5.019007
-');
+  LEN = \\d+');
 }
 
 if (ord('A') == 193) {
-do_test('reference to hash containing Unicode',
+do_test(19,
 	{chr(256)=>chr(512)},
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = [12]
+    REFCNT = 1
     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
     UV = 1					# $] < 5.009
     NV = $FLOAT					# $] < 5.009
@@ -550,29 +445,26 @@ do_test('reference to hash containing Unicode',
     KEYS = 1
     FILL = 1
     MAX = 7
+    RITER = -1
+    EITER = $ADDR
     Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
     SV = PV\\($ADDR\\) at $ADDR
       REFCNT = 1
-      FLAGS = \\(POK,(?:IsCOW,)?pPOK,UTF8\\)
+      FLAGS = \\(POK,pPOK,UTF8\\)
       PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
       CUR = 2
-      LEN = \\d+
-      COW_REFCNT = 1				# $] < 5.019007
-',      '',
-	$] > 5.009
-	? $] >= 5.015
-	    ?  0
-	    : 'The hash iterator used in dump.c sets the OOK flag'
+      LEN = \\d+',
+	$] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
 	: 'sv_length has been called on the element, and cached the result in MAGIC');
 } else {
-do_test('reference to hash containing Unicode',
+do_test(19,
 	{chr(256)=>chr(512)},
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = [12]
+    REFCNT = 1
     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
     UV = 1					# $] < 5.009
     NV = 0					# $] < 5.009
@@ -581,61 +473,49 @@ do_test('reference to hash containing Unicode',
     KEYS = 1
     FILL = 1
     MAX = 7
+    RITER = -1
+    EITER = $ADDR
     Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
     SV = PV\\($ADDR\\) at $ADDR
       REFCNT = 1
-      FLAGS = \\(POK,(?:IsCOW,)?pPOK,UTF8\\)
+      FLAGS = \\(POK,pPOK,UTF8\\)
       PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
       CUR = 2
-      LEN = \\d+
-      COW_REFCNT = 1				# $] < 5.019007
-',      '',
-	$] > 5.009
-	? $] >= 5.015
-	    ?  0
-	    : 'The hash iterator used in dump.c sets the OOK flag'
+      LEN = \\d+', '',
+	$] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
 	: 'sv_length has been called on the element, and cached the result in MAGIC');
 }
 
 my $x="";
 $x=~/.??/g;
-do_test('scalar with pos magic',
+do_test(20,
         $x,
 'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?pPOK\\)
-  IV = \d+
+  FLAGS = \\($PADMY,SMG,POK,pPOK\\)
+  IV = 0
   NV = 0
   PV = $ADDR ""\\\0
   CUR = 0
   LEN = \d+
-  COW_REFCNT = [12]
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_mglob
     MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
-    MG_FLAGS = 0x01					# $] < 5.019003
-    MG_FLAGS = 0x41					# $] >=5.019003
-      MINMATCH
-      BYTES						# $] >=5.019003
-');
+    MG_FLAGS = 0x01
+      MINMATCH');
 
 #
 # TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
 # environment variables may be invisibly case-forced, hence the (?i:PATH)
 # C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
-# Perl 5.18 ensures all env vars end up as strings only, hence the (?:,pIOK)?
-# Perl 5.18 ensures even magic vars have public OK, hence the (?:,POK)?
 # VMS is setting FAKE and READONLY flags.  What VMS uses for storing
 # ENV hashes is also not always null terminated.
 #
-if (${^TAINT}) {
-  # Save and restore PATH, since fresh_perl ends up using that in Windows.
-  my $path = $ENV{PATH};
-  do_test('tainted value in %ENV',
-          $ENV{PATH}=@ARGV,  # scalar(@ARGV) is a handy known tainted value
+do_test(21,
+        $ENV{PATH}=@ARGV,  # scalar(@ARGV) is a handy known tainted value
 'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\(GMG,SMG,RMG(?:,POK)?(?:,pIOK)?,pPOK\\)
+  FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
   IV = 0
   NV = 0
   PV = $ADDR "0"\\\0
@@ -650,7 +530,7 @@ if (${^TAINT}) {
     MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
     SV = PV(?:IV)?\\($ADDR\\) at $ADDR
       REFCNT = \d+
-      FLAGS = \\((?:TEMP,)?POK,(?:FAKE,READONLY,)?pPOK\\)
+      FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
 (?:      IV = 0
 )?      PV = $ADDR "(?i:PATH)"(?:\\\0)?
       CUR = \d+
@@ -658,10 +538,9 @@ if (${^TAINT}) {
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_taint
     MG_TYPE = PERL_MAGIC_taint\\(t\\)');
-    $ENV{PATH} = $path;
-}
 
-do_test('blessed reference',
+# blessed refs
+do_test(22,
 	bless(\\undef, 'Foobar'),
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -681,11 +560,13 @@ do_test('blessed reference',
     LEN = 0
     STASH = $ADDR\s+"Foobar"');
 
+# Constant subroutines
+
 sub const () {
     "Perl rules";
 }
 
-do_test('constant subroutine',
+do_test(23,
 	\&const,
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -693,8 +574,7 @@ do_test('constant subroutine',
   RV = $ADDR
   SV = PVCV\\($ADDR\\) at $ADDR
     REFCNT = (2)
-    FLAGS = \\(POK,pPOK,CONST,ISXSUB\\)		# $] < 5.015
-    FLAGS = \\(POK,pPOK,CONST,DYNFILE,ISXSUB\\)	# $] >= 5.015
+    FLAGS = \\(POK,pPOK,CONST\\)
     IV = 0					# $] < 5.009
     NV = 0					# $] < 5.009
     PROTOTYPE = ""
@@ -704,25 +584,23 @@ do_test('constant subroutine',
     XSUBANY = $ADDR \\(CONST SV\\)
     SV = PV\\($ADDR\\) at $ADDR
       REFCNT = 1
-      FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
+      FLAGS = \\(.*POK,READONLY,pPOK\\)
       PV = $ADDR "Perl rules"\\\0
       CUR = 10
       LEN = \\d+
-      COW_REFCNT = 0
     GVGV::GV = $ADDR\\t"main" :: "const"
     FILE = ".*\\b(?i:peek\\.t)"
     DEPTH = 0(?:
     MUTEXP = $ADDR
     OWNER = $ADDR)?
     FLAGS = 0x200				# $] < 5.009
-    FLAGS = 0xc00				# $] >= 5.009 && $] < 5.013
-    FLAGS = 0xc					# $] >= 5.013 && $] < 5.015
-    FLAGS = 0x100c				# $] >= 5.015
+    FLAGS = 0xc00				# $] >= 5.009
     OUTSIDE_SEQ = 0
     PADLIST = 0x0
     OUTSIDE = 0x0 \\(null\\)');	
 
-do_test('isUV should show on PVMG',
+# isUV should show on PVMG
+do_test(24,
 	do { my $v = $1; $v = ~0; $v },
 'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -731,7 +609,7 @@ do_test('isUV should show on PVMG',
   NV = 0
   PV = 0');
 
-do_test('IO',
+do_test(25,
 	*STDOUT{IO},
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -740,9 +618,9 @@ do_test('IO',
   SV = PVIO\\($ADDR\\) at $ADDR
     REFCNT = 3
     FLAGS = \\(OBJECT\\)
-    IV = 0					# $] < 5.011
+    IV = 0
     NV = 0					# $] < 5.011
-    STASH = $ADDR\s+"IO::File"
+    STASH = $ADDR\s+"IO::Handle"
     IFP = $ADDR
     OFP = $ADDR
     DIRP = 0x0
@@ -755,9 +633,9 @@ do_test('IO',
     BOTTOM_GV = 0x0
     SUBPROCESS = 0				# $] < 5.009
     TYPE = \'>\'
-    FLAGS = 0x4');
+    FLAGS = 0x0');
 
-do_test('FORMAT',
+do_test(26,
 	*PIE{FORMAT},
 'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
@@ -765,9 +643,8 @@ do_test('FORMAT',
   RV = $ADDR
   SV = PVFM\\($ADDR\\) at $ADDR
     REFCNT = 2
-    FLAGS = \\(\\)				# $] < 5.015 || !thr
-    FLAGS = \\(DYNFILE\\)			# $] >= 5.015 && thr
-    IV = 0					# $] < 5.009
+    FLAGS = \\(\\)
+    IV = 0
     NV = 0					# $] < 5.009
 (?:    PV = 0
 )?    COMP_STASH = 0x0
@@ -776,783 +653,13 @@ do_test('FORMAT',
     XSUB = 0x0					# $] < 5.009
     XSUBANY = 0					# $] < 5.009
     GVGV::GV = $ADDR\\t"main" :: "PIE"
-    FILE = ".*\\b(?i:peek\\.t)"(?:
-    DEPTH = 0)?(?:
+    FILE = ".*\\b(?i:peek\\.t)"
+(?:    DEPTH = 0
     MUTEXP = $ADDR
-    OWNER = $ADDR)?
-    FLAGS = 0x0					# $] < 5.015 || !thr
-    FLAGS = 0x1000				# $] >= 5.015 && thr
+    OWNER = $ADDR
+)?    FLAGS = 0x0
     OUTSIDE_SEQ = \\d+
-    LINES = 0					# $] < 5.017_003
+    LINES = 0
     PADLIST = $ADDR
     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
     OUTSIDE = $ADDR \\(MAIN\\)');
-
-do_test('blessing to a class with embedded NUL characters',
-        (bless {}, "\0::foo::\n::baz::\t::\0"),
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = [12]
-    FLAGS = \\(OBJECT,SHAREKEYS\\)
-    IV = 0					# $] < 5.009
-    NV = 0					# $] < 5.009
-    STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0"
-    ARRAY = $ADDR
-    KEYS = 0
-    FILL = 0
-    MAX = 7', '',
-	$] > 5.009
-	? $] >= 5.015
-	    ?  0
-	    : 'The hash iterator used in dump.c sets the OOK flag'
-	: "Something causes the HV's array to become allocated");
-
-do_test('ENAME on a stash',
-        \%RWOM::,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(OOK,SHAREKEYS\\)
-    IV = 1					# $] < 5.009
-    NV = $FLOAT					# $] < 5.009
-    AUX_FLAGS = 0                               # $] > 5.019008
-    ARRAY = $ADDR
-    KEYS = 0
-    FILL = 0 \(cached = 0\)
-    MAX = 7
-    RITER = -1
-    EITER = 0x0
-    RAND = $ADDR
-    NAME = "RWOM"
-    ENAME = "RWOM"				# $] > 5.012
-');
-
-*KLANK:: = \%RWOM::;
-
-do_test('ENAMEs on a stash',
-        \%RWOM::,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 3
-    FLAGS = \\(OOK,SHAREKEYS\\)
-    IV = 1					# $] < 5.009
-    NV = $FLOAT					# $] < 5.009
-    AUX_FLAGS = 0                               # $] > 5.019008
-    ARRAY = $ADDR
-    KEYS = 0
-    FILL = 0 \(cached = 0\)
-    MAX = 7
-    RITER = -1
-    EITER = 0x0
-    RAND = $ADDR
-    NAME = "RWOM"
-    NAMECOUNT = 2				# $] > 5.012
-    ENAME = "RWOM", "KLANK"			# $] > 5.012
-');
-
-undef %RWOM::;
-
-do_test('ENAMEs on a stash with no NAME',
-        \%RWOM::,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 3
-    FLAGS = \\(OOK,SHAREKEYS\\)			# $] < 5.017
-    FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\)	# $] >=5.017
-    IV = 1					# $] < 5.009
-    NV = $FLOAT					# $] < 5.009
-    AUX_FLAGS = 0                               # $] > 5.019008
-    ARRAY = $ADDR
-    KEYS = 0
-    FILL = 0 \(cached = 0\)
-    MAX = 7
-    RITER = -1
-    EITER = 0x0
-    RAND = $ADDR
-    NAMECOUNT = -3				# $] > 5.012
-    ENAME = "RWOM", "KLANK"			# $] > 5.012
-');
-
-my %small = ("Perl", "Rules", "Beer", "Foamy");
-my $b = %small;
-do_test('small hash',
-        \%small,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(PADMY,SHAREKEYS\\)
-    IV = 1					# $] < 5.009
-    NV = $FLOAT					# $] < 5.009
-    ARRAY = $ADDR  \\(0:[67],.*\\)
-    hash quality = [0-9.]+%
-    KEYS = 2
-    FILL = [12]
-    MAX = 7
-(?:    Elt "(?:Perl|Beer)" HASH = $ADDR
-    SV = PV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
-      PV = $ADDR "(?:Rules|Foamy)"\\\0
-      CUR = \d+
-      LEN = \d+
-      COW_REFCNT = 1
-){2}');
-
-$b = keys %small;
-
-do_test('small hash after keys',
-        \%small,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
-    IV = 1					# $] < 5.009
-    NV = $FLOAT					# $] < 5.009
-    AUX_FLAGS = 0                               # $] > 5.019008
-    ARRAY = $ADDR  \\(0:[67],.*\\)
-    hash quality = [0-9.]+%
-    KEYS = 2
-    FILL = [12] \\(cached = 0\\)
-    MAX = 7
-    RITER = -1
-    EITER = 0x0
-    RAND = $ADDR
-(?:    Elt "(?:Perl|Beer)" HASH = $ADDR
-    SV = PV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
-      PV = $ADDR "(?:Rules|Foamy)"\\\0
-      CUR = \d+
-      LEN = \d+
-      COW_REFCNT = 1
-){2}');
-
-$b = %small;
-
-do_test('small hash after keys and scalar',
-        \%small,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
-    IV = 1					# $] < 5.009
-    NV = $FLOAT					# $] < 5.009
-    AUX_FLAGS = 0                               # $] > 5.019008
-    ARRAY = $ADDR  \\(0:[67],.*\\)
-    hash quality = [0-9.]+%
-    KEYS = 2
-    FILL = ([12]) \\(cached = \1\\)
-    MAX = 7
-    RITER = -1
-    EITER = 0x0
-    RAND = $ADDR
-(?:    Elt "(?:Perl|Beer)" HASH = $ADDR
-    SV = PV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(POK,(?:IsCOW,)?pPOK\\)
-      PV = $ADDR "(?:Rules|Foamy)"\\\0
-      CUR = \d+
-      LEN = \d+
-      COW_REFCNT = 1
-){2}');
-
-# This should immediately start with the FILL cached correctly.
-my %large = (0..1999);
-$b = %large;
-do_test('large hash',
-        \%large,
-'SV = $RV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(ROK\\)
-  RV = $ADDR
-  SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
-    FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
-    IV = 1					# $] < 5.009
-    NV = $FLOAT					# $] < 5.009
-    AUX_FLAGS = 0                               # $] > 5.019008
-    ARRAY = $ADDR  \\(0:\d+,.*\\)
-    hash quality = \d+\\.\d+%
-    KEYS = 1000
-    FILL = (\d+) \\(cached = \1\\)
-    MAX = 1023
-    RITER = -1
-    EITER = 0x0
-    RAND = $ADDR
-    Elt .*
-');
-
-# Dump with arrays, hashes, and operator return values
-@array = 1..3;
-do_test('Dump @array', '@array', <<'ARRAY', '', '', 1);
-SV = PVAV\($ADDR\) at $ADDR
-  REFCNT = 1
-  FLAGS = \(\)
-  ARRAY = $ADDR
-  FILL = 2
-  MAX = 3
-  ARYLEN = 0x0
-  FLAGS = \(REAL\)
-  Elt No. 0
-  SV = IV\($ADDR\) at $ADDR
-    REFCNT = 1
-    FLAGS = \(IOK,pIOK\)
-    IV = 1
-  Elt No. 1
-  SV = IV\($ADDR\) at $ADDR
-    REFCNT = 1
-    FLAGS = \(IOK,pIOK\)
-    IV = 2
-  Elt No. 2
-  SV = IV\($ADDR\) at $ADDR
-    REFCNT = 1
-    FLAGS = \(IOK,pIOK\)
-    IV = 3
-ARRAY
-%hash = 1..2;
-do_test('Dump %hash', '%hash', <<'HASH', '', '', 1);
-SV = PVHV\($ADDR\) at $ADDR
-  REFCNT = 1
-  FLAGS = \(SHAREKEYS\)
-  ARRAY = $ADDR  \(0:7, 1:1\)
-  hash quality = 100.0%
-  KEYS = 1
-  FILL = 1
-  MAX = 7
-  Elt "1" HASH = $ADDR
-  SV = IV\($ADDR\) at $ADDR
-    REFCNT = 1
-    FLAGS = \(IOK,pIOK\)
-    IV = 2
-HASH
-$_ = "hello";
-do_test('rvalue substr', 'substr $_, 1, 2', <<'SUBSTR', '', '', 1);
-SV = PV\($ADDR\) at $ADDR
-  REFCNT = 1
-  FLAGS = \(PADTMP,POK,pPOK\)
-  PV = $ADDR "el"\\0
-  CUR = 2
-  LEN = \d+
-SUBSTR
-
-# Dump with no arguments
-eval 'Dump';
-like $@, qr/^Not enough arguments for Devel::Peek::Dump/, 'Dump;';
-eval 'Dump()';
-like $@, qr/^Not enough arguments for Devel::Peek::Dump/, 'Dump()';
-
-SKIP: {
-    skip "Not built with usemymalloc", 2
-      unless $Config{usemymalloc} eq 'y';
-    my $x = __PACKAGE__;
-    ok eval { fill_mstats($x); 1 }, 'fill_mstats on COW scalar'
-     or diag $@;
-    my $y;
-    ok eval { fill_mstats($y); 1 }, 'fill_mstats on undef scalar';
-}
-
-# This is more a test of fbm_compile/pp_study (non) interaction than dumping
-# prowess, but short of duplicating all the gubbins of this file, I can't see
-# a way to make a better place for it:
-
-use constant {
-    perl => 'rules',
-    beer => 'foamy',
-};
-
-unless ($Config{useithreads}) {
-    # These end up as copies in pads under ithreads, which rather defeats the
-    # the point of what we're trying to test here.
-
-    do_test('regular string constant', perl,
-'SV = PV\\($ADDR\\) at $ADDR
-  REFCNT = 5
-  FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
-  PV = $ADDR "rules"\\\0
-  CUR = 5
-  LEN = \d+
-  COW_REFCNT = 0
-');
-
-    eval 'index "", perl';
-
-    # FIXME - really this shouldn't say EVALED. It's a false posistive on
-    # 0x40000000 being used for several things, not a flag for "I'm in a string
-    # eval"
-
-    do_test('string constant now an FBM', perl,
-'SV = PVMG\\($ADDR\\) at $ADDR
-  REFCNT = 5
-  FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
-  PV = $ADDR "rules"\\\0
-  CUR = 5
-  LEN = \d+
-  COW_REFCNT = 0
-  MAGIC = $ADDR
-    MG_VIRTUAL = &PL_vtbl_regexp
-    MG_TYPE = PERL_MAGIC_bm\\(B\\)
-    MG_LEN = 256
-    MG_PTR = $ADDR "(?:\\\\\d){256}"
-  RARE = \d+					# $] < 5.019002
-  PREVIOUS = 1					# $] < 5.019002
-  USEFUL = 100
-');
-
-    is(study perl, '', "Not allowed to study an FBM");
-
-    do_test('string constant still an FBM', perl,
-'SV = PVMG\\($ADDR\\) at $ADDR
-  REFCNT = 5
-  FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
-  PV = $ADDR "rules"\\\0
-  CUR = 5
-  LEN = \d+
-  COW_REFCNT = 0
-  MAGIC = $ADDR
-    MG_VIRTUAL = &PL_vtbl_regexp
-    MG_TYPE = PERL_MAGIC_bm\\(B\\)
-    MG_LEN = 256
-    MG_PTR = $ADDR "(?:\\\\\d){256}"
-  RARE = \d+					# $] < 5.019002
-  PREVIOUS = 1					# $] < 5.019002
-  USEFUL = 100
-');
-
-    do_test('regular string constant', beer,
-'SV = PV\\($ADDR\\) at $ADDR
-  REFCNT = 6
-  FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
-  PV = $ADDR "foamy"\\\0
-  CUR = 5
-  LEN = \d+
-  COW_REFCNT = 0
-');
-
-    is(study beer, 1, "Our studies were successful");
-
-    do_test('string constant quite unaffected', beer, 'SV = PV\\($ADDR\\) at $ADDR
-  REFCNT = 6
-  FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
-  PV = $ADDR "foamy"\\\0
-  CUR = 5
-  LEN = \d+
-  COW_REFCNT = 0
-');
-
-    my $want = 'SV = PVMG\\($ADDR\\) at $ADDR
-  REFCNT = 6
-  FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
-  PV = $ADDR "foamy"\\\0
-  CUR = 5
-  LEN = \d+
-  COW_REFCNT = 0
-  MAGIC = $ADDR
-    MG_VIRTUAL = &PL_vtbl_regexp
-    MG_TYPE = PERL_MAGIC_bm\\(B\\)
-    MG_LEN = 256
-    MG_PTR = $ADDR "(?:\\\\\d){256}"
-  RARE = \d+					# $] < 5.019002
-  PREVIOUS = \d+				# $] < 5.019002
-  USEFUL = 100
-';
-
-    is (eval 'index "not too foamy", beer', 8, 'correct index');
-
-    do_test('string constant now FBMed', beer, $want);
-
-    my $pie = 'good';
-
-    is(study $pie, 1, "Our studies were successful");
-
-    do_test('string constant still FBMed', beer, $want);
-
-    do_test('second string also unaffected', $pie, 'SV = PV\\($ADDR\\) at $ADDR
-  REFCNT = 1
-  FLAGS = \\(PADMY,POK,(?:IsCOW,)?pPOK\\)
-  PV = $ADDR "good"\\\0
-  CUR = 4
-  LEN = \d+
-  COW_REFCNT = 1
-');
-}
-
-# (One block of study tests removed when study was made a no-op.)
-
-{
-    open(OUT,">peek$$") or die "Failed to open peek $$: $!";
-    open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
-    DeadCode();
-    open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
-    pass "no crash with DeadCode";
-    close OUT;
-}
-# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
-do_test('UTF-8 in a regular expression',
-        qr/\x{100}/,
-'SV = IV\($ADDR\) at $ADDR
-  REFCNT = 1
-  FLAGS = \(ROK\)
-  RV = $ADDR
-  SV = REGEXP\($ADDR\) at $ADDR
-    REFCNT = 1
-    FLAGS = \(OBJECT,FAKE,UTF8\)
-    PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
-    CUR = 13
-    STASH = $ADDR	"Regexp"
-    COMPFLAGS = 0x0 \(\)
-    EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-(?:    ENGINE = $ADDR \(STANDARD\)
-)?    INTFLAGS = 0x0(?: \(\))?
-    NPARENS = 0
-    LASTPAREN = 0
-    LASTCLOSEPAREN = 0
-    MINLEN = 1
-    MINLENRET = 1
-    GOFS = 0
-    PRE_PREFIX = 5
-    SUBLEN = 0
-    SUBOFFSET = 0
-    SUBCOFFSET = 0
-    SUBBEG = 0x0
-(?:    ENGINE = $ADDR
-)?    MOTHER_RE = $ADDR'
-. ($] < 5.019003 ? '' : '
-    SV = REGEXP\($ADDR\) at $ADDR
-      REFCNT = 2
-      FLAGS = \(UTF8\)
-      PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
-      CUR = 13
-      COMPFLAGS = 0x0 \(\)
-      EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-(?:      ENGINE = $ADDR \(STANDARD\)
-)?      INTFLAGS = 0x0(?: \(\))?
-      NPARENS = 0
-      LASTPAREN = 0
-      LASTCLOSEPAREN = 0
-      MINLEN = 1
-      MINLENRET = 1
-      GOFS = 0
-      PRE_PREFIX = 5
-      SUBLEN = 0
-      SUBOFFSET = 0
-      SUBCOFFSET = 0
-      SUBBEG = 0x0
-(?:    ENGINE = $ADDR
-)?      MOTHER_RE = 0x0
-      PAREN_NAMES = 0x0
-      SUBSTRS = $ADDR
-      PPRIVATE = $ADDR
-      OFFS = $ADDR
-      QR_ANONCV = 0x0(?:
-      SAVED_COPY = 0x0)?') . '
-    PAREN_NAMES = 0x0
-    SUBSTRS = $ADDR
-    PPRIVATE = $ADDR
-    OFFS = $ADDR
-    QR_ANONCV = 0x0(?:
-    SAVED_COPY = 0x0)?
-');
-
-{ # perl #117793: Extend SvREFCNT* to work on any perl variable type
-  my %hash;
-  my $base_count = Devel::Peek::SvREFCNT(%hash);
-  my $ref = \%hash;
-  is(Devel::Peek::SvREFCNT(%hash), $base_count + 1, "SvREFCNT on non-scalar");
-  ok(!eval { &Devel::Peek::SvREFCNT(1) }, "requires prototype");
-}
-{
-# utf8 tests
-use utf8;
-
-sub _dump {
-   open(OUT,">peek$$") or die $!;
-   open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
-   Dump($_[0]);
-   open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
-   close(OUT);
-   open(IN, "peek$$") or die $!;
-   my $dump = do { local $/; <IN> };
-   close(IN);
-   1 while unlink "peek$$";
-   return $dump;
-}
-
-sub _get_coderef {
-   my $x = $_[0];
-   utf8::upgrade($x);
-   eval "sub $x {}; 1" or die $@;
-   return *{$x}{CODE};
-}
-
-like(
-   _dump(_get_coderef("\x{df}::\xdf")),
-   qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\xdf" :: "\xdf"/,
-   "GVGV's are correctly escaped for latin1 :: latin1",
-);
-
-like(
-   _dump(_get_coderef("\x{30cd}::\x{30cd}")),
-   qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\x{30cd}" :: "\x{30cd}"/,
-   "GVGV's are correctly escaped for UTF8 :: UTF8",
-);
-
-like(
-   _dump(_get_coderef("\x{df}::\x{30cd}")),
-   qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\xdf" :: "\x{30cd}"/,
-   "GVGV's are correctly escaped for latin1 :: UTF8",
-);
-
-like(
-   _dump(_get_coderef("\x{30cd}::\x{df}")),
-   qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\x{30cd}" :: "\xdf"/,
-   "GVGV's are correctly escaped for UTF8 :: latin1",
-);
-
-like(
-   _dump(_get_coderef("\x{30cb}::\x{df}::\x{30cd}")),
-   qr/GVGV::GV = 0x[[:xdigit:]]+\s+\Q"\x{30cb}::\x{df}" :: "\x{30cd}"/,
-   "GVGV's are correctly escaped for UTF8 :: latin 1 :: UTF8",
-);
-
-my $dump = _dump(*{"\x{30cb}::\x{df}::\x{30dc}"});
-
-like(
-   $dump,
-   qr/NAME = \Q"\x{30dc}"/,
-   "NAME is correctly escaped for UTF8 globs",
-);
-
-like(
-   $dump,
-   qr/GvSTASH = 0x[[:xdigit:]]+\s+\Q"\x{30cb}::\x{df}"/,
-   "GvSTASH is correctly escaped for UTF8 globs"
-);
-
-like(
-   $dump,
-   qr/EGV = 0x[[:xdigit:]]+\s+\Q"\x{30dc}"/,
-   "EGV is correctly escaped for UTF8 globs"
-);
-
-$dump = _dump(*{"\x{df}::\x{30cc}"});
-
-like(
-   $dump,
-   qr/NAME = \Q"\x{30cc}"/,
-   "NAME is correctly escaped for UTF8 globs with latin1 stashes",
-);
-
-like(
-   $dump,
-   qr/GvSTASH = 0x[[:xdigit:]]+\s+\Q"\xdf"/,
-   "GvSTASH is correctly escaped for UTF8 globs with latin1 stashes"
-);
-
-like(
-   $dump,
-   qr/EGV = 0x[[:xdigit:]]+\s+\Q"\x{30cc}"/,
-   "EGV is correctly escaped for UTF8 globs with latin1 stashes"
-);
-
-like(
-   _dump(bless {}, "\0::\1::\x{30cd}"),
-   qr/STASH = 0x[[:xdigit:]]+\s+\Q"\0::\x{01}::\x{30cd}"/,
-   "STASH for blessed hashrefs is correct"
-);
-
-BEGIN { $::{doof} = "\0\1\x{30cd}" }
-like(
-   _dump(\&doof),
-   qr/PROTOTYPE = \Q"\0\x{01}\x{30cd}"/,
-   "PROTOTYPE is escaped correctly"
-);
-
-{
-    my $coderef = eval <<"EOP";
-    use feature 'lexical_subs';
-    no warnings 'experimental::lexical_subs';
-    my sub bar (\$\x{30cd}) {1}; \\&bar
-EOP
-    like(
-       _dump($coderef),
-       qr/PROTOTYPE = "\$\Q\x{30cd}"/,
-       "PROTOTYPE works on lexical subs"
-    )
-}
-
-sub get_outside {
-   eval "sub $_[0] { my \$x; \$x++; return sub { eval q{\$x} } } $_[0]()";
-}
-sub basic { my $x; return eval q{sub { eval q{$x} }} }
-like(
-    _dump(basic()),
-    qr/OUTSIDE = 0x[[:xdigit:]]+\s+\Q(basic)/,
-    'OUTSIDE works'
-);
-
-like(
-    _dump(get_outside("\x{30ce}")),
-    qr/OUTSIDE = 0x[[:xdigit:]]+\s+\Q(\x{30ce})/,
-    'OUTSIDE + UTF8 works'
-);
-
-# TODO AUTOLOAD = stashname, which requires using a XS autoload
-# and calling Dump() on the cv
-
-
-
-sub test_utf8_stashes {
-   my ($stash_name, $test) = @_;
-
-   $dump = _dump(\%{"${stash_name}::"});
-
-   my $format = utf8::is_utf8($stash_name) ? '\x{%2x}' : '\x%2x';
-   $escaped_stash_name = join "", map {
-         $_ eq ':' ? $_ : sprintf $format, ord $_
-   } split //, $stash_name;
-
-   like(
-      $dump,
-      qr/\QNAME = "$escaped_stash_name"/,
-      "NAME is correct escaped for $test"
-   );
-
-   like(
-      $dump,
-      qr/\QENAME = "$escaped_stash_name"/,
-      "ENAME is correct escaped for $test"
-   );
-}
-
-for my $test (
-  [ "\x{30cd}", "UTF8 stashes" ],
-   [ "\x{df}", "latin 1 stashes" ],
-   [ "\x{df}::\x{30cd}", "latin1 + UTF8 stashes" ],
-   [ "\x{30cd}::\x{df}", "UTF8 + latin1 stashes" ],
-) {
-   test_utf8_stashes(@$test);
-}
-
-}
-
-sub test_DumpProg {
-    my ($prog, $expected, $name, $test) = @_;
-    $test ||= 'like';
-
-    my $u = 'use Devel::Peek "DumpProg"; DumpProg();';
-
-    # Interface between Test::Builder & test.pl
-    my $builder = Test::More->builder();
-    t::curr_test($builder->current_test() + 1);
-
-    utf8::encode($prog);
-    
-    if ( $test eq 'is' ) {
-        t::fresh_perl_is($prog . $u, $expected, undef, $name)
-    }
-    else {
-        t::fresh_perl_like($prog . $u, $expected, undef, $name)
-    }
-
-    $builder->current_test(t::curr_test() - 1);
-}
-
-my $threads = $Config{'useithreads'};
-
-for my $test (
-[
-    "package test;",
-    qr/PACKAGE = "test"/,
-    "DumpProg() + package declaration"
-],
-[
-    "use utf8; package \x{30cd};",
-    qr/PACKAGE = "\\x\Q{30cd}"/,
-    "DumpProg() + UTF8 package declaration"
-],
-[
-    "use utf8; sub \x{30cc}::\x{30cd} {1}; \x{30cc}::\x{30cd};",
-    ($threads ? qr/PADIX = \d+/ : qr/GV = \Q\x{30cc}::\x{30cd}\E/)
-],
-[
-    "use utf8; \x{30cc}: { last \x{30cc} }",
-    qr/LABEL = \Q"\x{30cc}"/
-],
-)
-{
-   test_DumpProg(@$test);
-}
-
-my $e = <<'EODUMP';
-dumpindent is 4 at - line 1.
-{
-1   TYPE = leave  ===> NULL
-    TARG = 1
-    FLAGS = (VOID,KIDS,PARENS,SLABBED)
-    PRIVATE = (REFCOUNTED)
-    REFCNT = 1
-    {
-2       TYPE = enter  ===> 3
-        FLAGS = (UNKNOWN,SLABBED)
-    }
-    {
-3       TYPE = nextstate  ===> 4
-        FLAGS = (VOID,SLABBED)
-        LINE = 1
-        PACKAGE = "t"
-    }
-    {
-5       TYPE = entersub  ===> 1
-        TARG = TARGS_REPLACE
-        FLAGS = (VOID,KIDS,STACKED,SLABBED)
-        PRIVATE = (HASTARG)
-        {
-6           TYPE = null  ===> (5)
-              (was list)
-            FLAGS = (UNKNOWN,KIDS,SLABBED)
-            {
-4               TYPE = pushmark  ===> 7
-                FLAGS = (SCALAR,SLABBED)
-            }
-            {
-8               TYPE = null  ===> (6)
-                  (was rv2cv)
-                FLAGS = (SCALAR,KIDS,SLABBED)
-                {
-7                   TYPE = gv  ===> 5
-                    FLAGS = (SCALAR,SLABBED)
-                    GV_OR_PADIX
-                }
-            }
-        }
-    }
-}
-EODUMP
-
-$e =~ s/TARGS_REPLACE/$threads ? 3 : 1/e;
-$e =~ s/GV_OR_PADIX/$threads ? "PADIX = 2" : "GV = t::DumpProg"/e;
-
-test_DumpProg("package t;", $e, "DumpProg() has no 'Attempt to free X prematurely' warning", "is" );
-
-done_testing();
diff --git a/gnu/usr.bin/perl/ext/File-Glob/Glob.pm b/gnu/usr.bin/perl/ext/File-Glob/Glob.pm
index 2b39dce6a8e..15d4adb6bbe 100644
--- a/gnu/usr.bin/perl/ext/File-Glob/Glob.pm
+++ b/gnu/usr.bin/perl/ext/File-Glob/Glob.pm
@@ -1,15 +1,38 @@
 package File::Glob;
 
 use strict;
-our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, $DEFAULT_FLAGS);
+our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS,
+    $AUTOLOAD, $DEFAULT_FLAGS);
 
-require XSLoader;
+use XSLoader ();
 
 @ISA = qw(Exporter);
 
 # NOTE: The glob() export is only here for compatibility with 5.6.0.
 # csh_glob() should not be used directly, unless you know what you're doing.
 
+@EXPORT_OK   = qw(
+    csh_glob
+    bsd_glob
+    glob
+    GLOB_ABEND
+    GLOB_ALPHASORT
+    GLOB_ALTDIRFUNC
+    GLOB_BRACE
+    GLOB_CSH
+    GLOB_ERR
+    GLOB_ERROR
+    GLOB_LIMIT
+    GLOB_MARK
+    GLOB_NOCASE
+    GLOB_NOCHECK
+    GLOB_NOMAGIC
+    GLOB_NOSORT
+    GLOB_NOSPACE
+    GLOB_QUOTE
+    GLOB_TILDE
+);
+
 %EXPORT_TAGS = (
     'glob' => [ qw(
         GLOB_ABEND
@@ -28,57 +51,140 @@ require XSLoader;
         GLOB_NOSPACE
         GLOB_QUOTE
         GLOB_TILDE
-        bsd_glob
         glob
+        bsd_glob
     ) ],
 );
-$EXPORT_TAGS{bsd_glob} = [@{$EXPORT_TAGS{glob}}];
-pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob"
 
-@EXPORT_OK   = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');
-
-$VERSION = '1.23';
+$VERSION = '1.06';
 
 sub import {
     require Exporter;
-    local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
-    Exporter::import(grep {
-        my $passthrough;
-        if ($_ eq ':case') {
-            $DEFAULT_FLAGS &= ~GLOB_NOCASE()
-        }
-        elsif ($_ eq ':nocase') {
-            $DEFAULT_FLAGS |= GLOB_NOCASE();
-        }
-        elsif ($_ eq ':globally') {
-	    no warnings 'redefine';
-	    *CORE::GLOBAL::glob = \&File::Glob::csh_glob;
+    my $i = 1;
+    while ($i < @_) {
+	if ($_[$i] =~ /^:(case|nocase|globally)$/) {
+	    splice(@_, $i, 1);
+	    $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
+	    $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
+	    if ($1 eq 'globally') {
+		local $^W;
+		*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
+	    }
+	    next;
 	}
-        elsif ($_ eq ':bsd_glob') {
-	    no strict; *{caller."::glob"} = \&bsd_glob_override;
-            $passthrough = 1;
-	}
-	else {
-            $passthrough = 1;
-        }
-        $passthrough;
-    } @_);
+	++$i;
+    }
+    goto &Exporter::import;
+}
+
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.  If a constant is not found then control is passed
+    # to the AUTOLOAD in AutoLoader.
+
+    my $constname;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    my ($error, $val) = constant($constname);
+    if ($error) {
+	require Carp;
+	Carp::croak($error);
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
 }
 
-XSLoader::load();
+XSLoader::load 'File::Glob', $VERSION;
+
+# Preloaded methods go here.
+
+sub GLOB_ERROR {
+    return (constant('GLOB_ERROR'))[1];
+}
+
+sub GLOB_CSH () {
+    GLOB_BRACE()
+	| GLOB_NOMAGIC()
+	| GLOB_QUOTE()
+	| GLOB_TILDE()
+	| GLOB_ALPHASORT()
+}
 
 $DEFAULT_FLAGS = GLOB_CSH();
-if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) {
+if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
     $DEFAULT_FLAGS |= GLOB_NOCASE();
 }
 
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+sub bsd_glob {
+    my ($pat,$flags) = @_;
+    $flags = $DEFAULT_FLAGS if @_ < 2;
+    return doglob($pat,$flags);
+}
+
 # File::Glob::glob() is deprecated because its prototype is different from
 # CORE::glob() (use bsd_glob() instead)
 sub glob {
-    splice @_, 1; # no flags
+    splice @_, 1; # don't pass PL_glob_index as flags!
     goto &bsd_glob;
 }
 
+## borrowed heavily from gsar's File::DosGlob
+my %iter;
+my %entries;
+
+sub csh_glob {
+    my $pat = shift;
+    my $cxix = shift;
+    my @pat;
+
+    # glob without args defaults to $_
+    $pat = $_ unless defined $pat;
+
+    # extract patterns
+    $pat =~ s/^\s+//;	# Protect against empty elements in
+    $pat =~ s/\s+$//;	# things like < *.c> and <*.c >.
+			# These alone shouldn't trigger ParseWords.
+    if ($pat =~ /\s/) {
+        # XXX this is needed for compatibility with the csh
+	# implementation in Perl.  Need to support a flag
+	# to disable this behavior.
+	require Text::ParseWords;
+	@pat = Text::ParseWords::parse_line('\s+',0,$pat);
+    }
+
+    # assume global context if not provided one
+    $cxix = '_G_' unless defined $cxix;
+    $iter{$cxix} = 0 unless exists $iter{$cxix};
+
+    # if we're just beginning, do it all first
+    if ($iter{$cxix} == 0) {
+	if (@pat) {
+	    $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
+	}
+	else {
+	    $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
+	}
+    }
+
+    # chuck it all out, quick or slow
+    if (wantarray) {
+        delete $iter{$cxix};
+        return @{delete $entries{$cxix}};
+    }
+    else {
+        if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
+            return shift @{$entries{$cxix}};
+        }
+        else {
+            # return undef for EOL
+            delete $iter{$cxix};
+            delete $entries{$cxix};
+            return undef;
+        }
+    }
+}
+
 1;
 __END__
 
@@ -88,7 +194,7 @@ File::Glob - Perl extension for BSD glob routine
 
 =head1 SYNOPSIS
 
-  use File::Glob ':bsd_glob';
+  use File::Glob ':glob';
 
   @list = bsd_glob('*.[ch]');
   $homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR);
@@ -131,8 +237,7 @@ Since v5.6.0, Perl's CORE::glob() is implemented in terms of bsd_glob().
 Note that they don't share the same prototype--CORE::glob() only accepts
 a single argument.  Due to historical reasons, CORE::glob() will also
 split its argument on whitespace, treating it as multiple patterns,
-whereas bsd_glob() considers them as one pattern.  But see C<:bsd_glob>
-under L</EXPORTS>, below.
+whereas bsd_glob() considers them as one pattern.
 
 =head2 META CHARACTERS
 
@@ -145,55 +250,9 @@ under L</EXPORTS>, below.
 
 The metanotation C<a{b,c,d}e> is a shorthand for C<abe ace ade>.  Left to
 right order is preserved, with results of matches being sorted separately
-at a low level to preserve this order.  As a special case C<{>, C<}>, and
+at a low level to preserve this order. As a special case C<{>, C<}>, and
 C<{}> are passed undisturbed.
 
-=head2 EXPORTS
-
-See also the L</POSIX FLAGS> below, which can be exported individually.
-
-=head3 C<:bsd_glob>
-
-The C<:bsd_glob> export tag exports bsd_glob() and the constants listed
-below.  It also overrides glob() in the calling package with one that
-behaves like bsd_glob() with regard to spaces (the space is treated as part
-of a file name), but supports iteration in scalar context; i.e., it
-preserves the core function's feature of returning the next item each time
-it is called.
-
-=head3 C<:glob>
-
-The C<:glob> tag, now discouraged, is the old version of C<:bsd_glob>.  It
-exports the same constants and functions, but its glob() override does not
-support iteration; it returns the last file name in scalar context.  That
-means this will loop forever:
-
-    use File::Glob ':glob';
-    while (my $file = <* copy.txt>) {
-	...
-    }
-
-=head3 C<bsd_glob>
-
-This function, which is included in the two export tags listed above,
-takes one or two arguments.  The first is the glob pattern.  The second is
-a set of flags ORed together.  The available flags are listed below under
-L</POSIX FLAGS>.  If the second argument is omitted, C<GLOB_CSH> (or
-C<GLOB_CSH|GLOB_NOCASE> on VMS and DOSish systems) is used by default.
-
-=head3 C<:nocase> and C<:case>
-
-These two export tags globally modify the default flags that bsd_glob()
-and, except on VMS, Perl's built-in C<glob> operator use.  C<GLOB_NOCASE>
-is turned on or off, respectively.
-
-=head3 C<csh_glob>
-
-The csh_glob() function can also be exported, but you should not use it
-directly unless you really know what you are doing.  It splits the pattern
-into words and feeds each one to bsd_glob().  Perl's own glob() function
-uses this internally.
-
 =head2 POSIX FLAGS
 
 The POSIX defined flags for bsd_glob() are:
@@ -334,10 +393,10 @@ Remember that you can use a backslash to escape things.
 
 On DOSISH systems, backslash is a valid directory separator character.
 In this case, use of backslash as a quoting character (via GLOB_QUOTE)
-interferes with the use of backslash as a directory separator.  The
+interferes with the use of backslash as a directory separator. The
 best (simplest, most portable) solution is to use forward slashes for
-directory separators, and backslashes for quoting.  However, this does
-not match "normal practice" on these systems.  As a concession to user
+directory separators, and backslashes for quoting. However, this does
+not match "normal practice" on these systems. As a concession to user
 expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
 glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
 All other backslashes are passed through unchanged.
@@ -348,6 +407,46 @@ Win32 users should use the real slash.  If you really want to use
 backslashes, consider using Sarathy's File::DosGlob, which comes with
 the standard Perl distribution.
 
+=item *
+
+Mac OS (Classic) users should note a few differences. Since
+Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
+~user) and the C<GLOB_TILDE> flag is used, it simply returns that
+pattern without doing any expansion.
+
+Glob on Mac OS is case-insensitive by default (if you don't use any
+flags). If you specify any flags at all and still want glob
+to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
+
+The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
+should be careful about specifying relative pathnames. While a full path
+always begins with a volume name, a relative pathname should always
+begin with a ':'.  If specifying a volume name only, a trailing ':' is
+required.
+
+The specification of pathnames in glob patterns adheres to the usual Mac
+OS conventions: The path separator is a colon ':', not a slash '/'. A
+full path always begins with a volume name. A relative pathname on Mac
+OS must always begin with a ':', except when specifying a file or
+directory name in the current working directory, where the leading colon
+is optional. If specifying a volume name only, a trailing ':' is
+required. Due to these rules, a glob like E<lt>*:E<gt> will find all
+mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find
+all files and directories in the current directory.
+
+Note that updirs in the glob pattern are resolved before the matching begins,
+i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also,
+that a single trailing ':' in the pattern is ignored (unless it's a volume
+name pattern like "*HD:"), i.e. a glob like E<lt>:*:E<gt> will find both
+directories I<and> files (and not, as one might expect, only directories).
+You can, however, use the C<GLOB_MARK> flag to distinguish (without a file
+test) directory names from file names.
+
+If the C<GLOB_MARK> flag is set, all directory paths will have a ':' appended.
+Since a directory like 'lib:' is I<not> a valid I<relative> path on Mac OS,
+both a leading and a trailing colon will be added, when the directory name in
+question doesn't contain any colons (e.g. 'lib' becomes ':lib:').
+
 =back
 
 =head1 SEE ALSO
@@ -382,7 +481,7 @@ following copyright:
        may be used to endorse or promote products derived from this software
        without specific prior written permission.
 
-    THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS "AS IS" AND
+    THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
     ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
     ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
diff --git a/gnu/usr.bin/perl/ext/File-Glob/Glob.xs b/gnu/usr.bin/perl/ext/File-Glob/Glob.xs
index 99d22f6af3e..3a526fbf03b 100644
--- a/gnu/usr.bin/perl/ext/File-Glob/Glob.xs
+++ b/gnu/usr.bin/perl/ext/File-Glob/Glob.xs
@@ -1,5 +1,3 @@
-#define PERL_NO_GET_CONTEXT
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -9,12 +7,7 @@
 #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
 
 typedef struct {
-#ifdef USE_ITHREADS
-    tTHX interp;
-#endif
     int		x_GLOB_ERROR;
-    HV *	x_GLOB_ENTRIES;
-    Perl_ophook_t	x_GLOB_OLD_OPHOOK;
 } my_cxt_t;
 
 START_MY_CXT
@@ -28,24 +21,37 @@ START_MY_CXT
 #else
 static int
 errfunc(const char *foo, int bar) {
-  PERL_UNUSED_ARG(foo);
   return !(bar == EACCES || bar == ENOENT || bar == ENOTDIR);
 }
 #endif
 
-static void
-doglob(pTHX_ const char *pattern, int flags)
+MODULE = File::Glob		PACKAGE = File::Glob
+
+BOOT:
 {
-    dSP;
+    MY_CXT_INIT;
+}
+
+void
+doglob(pattern,...)
+    char *pattern
+PROTOTYPE: $;$
+PREINIT:
     glob_t pglob;
     int i;
     int retval;
+    int flags = 0;
     SV *tmp;
+PPCODE:
     {
 	dMY_CXT;
 
+	/* allow for optional flags argument */
+	if (items > 1) {
+	    flags = (int) SvIV(ST(1));
+	}
+
 	/* call glob */
-	memset(&pglob, 0, sizeof(glob_t));
 	retval = bsd_glob(pattern, flags, errfunc, &pglob);
 	GLOB_ERROR = retval;
 
@@ -53,409 +59,14 @@ doglob(pTHX_ const char *pattern, int flags)
 	EXTEND(sp, pglob.gl_pathc);
 	for (i = 0; i < pglob.gl_pathc; i++) {
 	    /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */
-	    tmp = newSVpvn_flags(pglob.gl_pathv[i], strlen(pglob.gl_pathv[i]),
-				 SVs_TEMP);
+	    tmp = sv_2mortal(newSVpvn(pglob.gl_pathv[i],
+				      strlen(pglob.gl_pathv[i])));
 	    TAINT;
 	    SvTAINT(tmp);
 	    PUSHs(tmp);
 	}
-	PUTBACK;
 
 	bsd_globfree(&pglob);
     }
-}
-
-static void
-iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, const char *pat, STRLEN len, bool is_utf8))
-{
-    dSP;
-    dMY_CXT;
-
-    const char * const cxixpv = (char *)&PL_op;
-    STRLEN const cxixlen = sizeof(OP *);
-    AV *entries;
-    U32 const gimme = GIMME_V;
-    SV *patsv = POPs;
-    bool on_stack = FALSE;
-
-    if (!MY_CXT.x_GLOB_ENTRIES) MY_CXT.x_GLOB_ENTRIES = newHV();
-    entries = (AV *)*(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1));
-
-    /* if we're just beginning, do it all first */
-    if (SvTYPE(entries) != SVt_PVAV) {
-        const char *pat;
-        STRLEN len;
-        bool is_utf8;
-
-        /* glob without args defaults to $_ */
-        SvGETMAGIC(patsv);
-        if (
-            !SvOK(patsv)
-              && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
-            ) {
-            pat = "";
-            len = 0;
-            is_utf8 = 0;
-        }
-        else {
-            pat = SvPV_nomg(patsv,len);
-            is_utf8 = !!SvUTF8(patsv);
-            /* the lower-level code expects a null-terminated string */
-            if (!SvPOK(patsv) || pat != SvPVX(patsv) || pat[len] != '\0') {
-                SV *newpatsv = newSVpvn_flags(pat, len, SVs_TEMP);
-                pat = SvPV_nomg(newpatsv,len);
-            }
-        }
-
-        if (!IS_SAFE_SYSCALL(pat, len, "pattern", "glob")) {
-            if (gimme != G_ARRAY)
-                PUSHs(&PL_sv_undef);
-            PUTBACK;
-            return;
-        }
-
-	PUTBACK;
-	on_stack = globber(aTHX_ entries, pat, len, is_utf8);
-	SPAGAIN;
-    }
-
-    /* chuck it all out, quick or slow */
-    if (gimme == G_ARRAY) {
-	if (!on_stack) {
-	    EXTEND(SP, AvFILLp(entries)+1);
-	    Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
-	    SP += AvFILLp(entries)+1;
-	}
-	/* No G_DISCARD here!  It will free the stack items. */
-	(void)hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0);
-    }
-    else {
-	if (AvFILLp(entries) + 1) {
-	    mPUSHs(av_shift(entries));
-	}
-	else {
-	    /* return undef for EOL */
-	    (void)hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, G_DISCARD);
-	    PUSHs(&PL_sv_undef);
-	}
-    }
-    PUTBACK;
-}
-
-/* returns true if the items are on the stack already, but only in
-   list context */
-static bool
-csh_glob(pTHX_ AV *entries, const char *pat, STRLEN len, bool is_utf8)
-{
-	dSP;
-	AV *patav = NULL;
-	const char *patend;
-	const char *s = NULL;
-	const char *piece = NULL;
-	SV *word = NULL;
-	int const flags =
-	    (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
-	U32 const gimme = GIMME_V;
-
-	patend = pat + len;
-
-	assert(SvTYPE(entries) != SVt_PVAV);
-	sv_upgrade((SV *)entries, SVt_PVAV);
-
-	/* extract patterns */
-	s = pat-1;
-	while (++s < patend) {
-	    switch (*s) {
-	    case '\'':
-	    case '"' :
-	      {
-		bool found = FALSE;
-		const char quote = *s;
-		if (!word) {
-		    word = newSVpvs("");
-		    if (is_utf8) SvUTF8_on(word);
-		}
-		if (piece) sv_catpvn(word, piece, s-piece);
-		piece = s+1;
-		while (++s < patend)
-		    if (*s == '\\') {
-			s++;
-			/* If the backslash is here to escape a quote,
-			   obliterate it. */
-			if (s < patend && *s == quote)
-			    sv_catpvn(word, piece, s-piece-1), piece = s;
-		    }
-		    else if (*s == quote) {
-			sv_catpvn(word, piece, s-piece);
-			piece = NULL;
-			found = TRUE;
-			break;
-		    }
-		if (!found) { /* unmatched quote */
-		    /* Give up on tokenisation and treat the whole string
-		       as a single token, but with whitespace stripped. */
-		    piece = pat;
-		    while (isSPACE(*pat)) pat++;
-		    while (isSPACE(*(patend-1))) patend--;
-		    /* bsd_glob expects a trailing null, but we cannot mod-
-		       ify the original */
-		    if (patend < pat + len) {
-			if (word) sv_setpvn(word, pat, patend-pat);
-			else
-			    word = newSVpvn_flags(
-				pat, patend-pat, SVf_UTF8*is_utf8
-			    );
-			piece = NULL;
-		    }
-		    else {
-			if (word) SvREFCNT_dec(word), word=NULL;
-			piece = pat;
-			s = patend;
-		    }
-		    goto end_of_parsing;
-		}
-		break;
-	      }
-	    case '\\':
-		if (!piece) piece = s;
-		s++;
-		/* If the backslash is here to escape a quote,
-		   obliterate it. */
-		if (s < patend && (*s == '"' || *s == '\'')) {
-		    if (!word) {
-			word = newSVpvn(piece,s-piece-1);
-			if (is_utf8) SvUTF8_on(word);
-		    }
-		    else sv_catpvn(word, piece, s-piece-1);
-		    piece = s;
-		}
-		break;
-	    default:
-		if (isSPACE(*s)) {
-		    if (piece) {
-			if (!word) {
-			    word = newSVpvn(piece,s-piece);
-			    if (is_utf8) SvUTF8_on(word);
-			}
-			else sv_catpvn(word, piece, s-piece);
-		    }
-		    if (!word) break;
-		    if (!patav) patav = (AV *)sv_2mortal((SV *)newAV());
-		    av_push(patav, word);
-		    word = NULL;
-		    piece = NULL;
-		}
-		else if (!piece) piece = s;
-		break;
-	    }
-	}
-      end_of_parsing:
-
-	if (patav) {
-	    I32 items = AvFILLp(patav) + 1;
-	    SV **svp = AvARRAY(patav);
-	    while (items--) {
-		PUSHMARK(SP);
-		PUTBACK;
-		doglob(aTHX_ SvPVXx(*svp++), flags);
-		SPAGAIN;
-		{
-		    dMARK;
-		    dORIGMARK;
-		    while (++MARK <= SP)
-			av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
-		    SP = ORIGMARK;
-		}
-	    }
-	}
-	/* piece is set at this point if there is no trailing whitespace.
-	   It is the beginning of the last token or quote-delimited
-	   piece thereof.  word is set at this point if the last token has
-	   multiple quoted pieces. */
-	if (piece || word) {
-	    if (word) {
-		if (piece) sv_catpvn(word, piece, s-piece);
-		piece = SvPVX(word);
-	    }
-	    PUSHMARK(SP);
-	    PUTBACK;
-	    doglob(aTHX_ piece, flags);
-	    if (word) SvREFCNT_dec(word);
-	    SPAGAIN;
-	    {
-		dMARK;
-		dORIGMARK;
-		/* short-circuit here for a fairly common case */
-		if (!patav && gimme == G_ARRAY) { PUTBACK; return TRUE; }
-		while (++MARK <= SP)
-		    av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
-
-		SP = ORIGMARK;
-	    }
-	}
-	PUTBACK;
-	return FALSE;
-}
-
-static void
-csh_glob_iter(pTHX)
-{
-    iterate(aTHX_ csh_glob);
-}
-
-/* wrapper around doglob that can be passed to the iterator */
-static bool
-doglob_iter_wrapper(pTHX_ AV *entries, const char *pattern, STRLEN len, bool is_utf8)
-{
-    dSP;
-    int const flags =
-	    (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
-
-    PERL_UNUSED_VAR(len); /* we use \0 termination instead */
-    /* XXX we currently just use the underlying bytes of the passed SV.
-     * Some day someone needs to make glob utf8 aware */
-    PERL_UNUSED_VAR(is_utf8);
-
-    PUSHMARK(SP);
-    PUTBACK;
-    doglob(aTHX_ pattern, flags);
-    SPAGAIN;
-    {
-	dMARK;
-	dORIGMARK;
-	if (GIMME_V == G_ARRAY) { PUTBACK; return TRUE; }
-	sv_upgrade((SV *)entries, SVt_PVAV);
-	while (++MARK <= SP)
-	    av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
-	SP = ORIGMARK;
-    }
-    return FALSE;
-}
-
-static void
-glob_ophook(pTHX_ OP *o)
-{
-  if (PL_dirty) return;
-  {
-    dMY_CXT;
-    if (MY_CXT.x_GLOB_ENTRIES
-     && (o->op_type == OP_GLOB || o->op_type == OP_ENTERSUB))
-	(void)hv_delete(MY_CXT.x_GLOB_ENTRIES, (char *)&o, sizeof(OP *),
-		  G_DISCARD);
-    if (MY_CXT.x_GLOB_OLD_OPHOOK) MY_CXT.x_GLOB_OLD_OPHOOK(aTHX_ o);
-  }
-}
-
-MODULE = File::Glob		PACKAGE = File::Glob
-
-int
-GLOB_ERROR()
-    PREINIT:
-	dMY_CXT;
-    CODE:
-	RETVAL = GLOB_ERROR;
-    OUTPUT:
-	RETVAL
-
-void
-bsd_glob(pattern_sv,...)
-    SV *pattern_sv
-PREINIT:
-    int flags = 0;
-    char *pattern;
-    STRLEN len;
-PPCODE:
-    {
-        pattern = SvPV(pattern_sv, len);
-        if (!IS_SAFE_SYSCALL(pattern, len, "pattern", "bsd_glob"))
-            XSRETURN(0);
-	/* allow for optional flags argument */
-	if (items > 1) {
-	    flags = (int) SvIV(ST(1));
-	    /* remove unsupported flags */
-	    flags &= ~(GLOB_APPEND | GLOB_DOOFFS | GLOB_ALTDIRFUNC | GLOB_MAGCHAR);
-	} else {
-	    flags = (int) SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
-	}
-	
-	PUTBACK;
-	doglob(aTHX_ pattern, flags);
-	SPAGAIN;
-    }
-
-PROTOTYPES: DISABLE
-void
-csh_glob(...)
-PPCODE:
-    /* For backward-compatibility with the original Perl function, we sim-
-     * ply take the first argument, regardless of how many there are.
-     */
-    if (items) SP ++;
-    else {
-	XPUSHs(&PL_sv_undef);
-    }
-    PUTBACK;
-    csh_glob_iter(aTHX);
-    SPAGAIN;
-
-void
-bsd_glob_override(...)
-PPCODE:
-    if (items) SP ++;
-    else {
-	XPUSHs(&PL_sv_undef);
-    }
-    PUTBACK;
-    iterate(aTHX_ doglob_iter_wrapper);
-    SPAGAIN;
-
-#ifdef USE_ITHREADS
-
-void
-CLONE(...)
-INIT:
-    HV *glob_entries_clone = NULL;
-CODE:
-    PERL_UNUSED_ARG(items);
-    {
-        dMY_CXT;
-        if ( MY_CXT.x_GLOB_ENTRIES ) {
-            CLONE_PARAMS param;
-            param.stashes    = NULL;
-            param.flags      = 0;
-            param.proto_perl = MY_CXT.interp;
-            
-            glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, &param));
-        }
-    }
-    {
-        MY_CXT_CLONE;
-        MY_CXT.x_GLOB_ENTRIES = glob_entries_clone;
-        MY_CXT.interp = aTHX;
-    }
-
-#endif
-
-BOOT:
-{
-#ifndef PERL_EXTERNAL_GLOB
-    /* Don't do this at home! The globhook interface is highly volatile. */
-    PL_globhook = csh_glob_iter;
-#endif
-}
-
-BOOT:
-{
-    MY_CXT_INIT;
-    {
-	dMY_CXT;
-	MY_CXT.x_GLOB_ENTRIES = NULL;
-	MY_CXT.x_GLOB_OLD_OPHOOK = PL_opfreehook;
-#ifdef USE_ITHREADS
-        MY_CXT.interp = aTHX;
-#endif
-	PL_opfreehook = glob_ophook;
-    }  
-}
 
 INCLUDE: const-xs.inc
diff --git a/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/FieldHash.xs b/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/FieldHash.xs
index 327b8200808..ccd7c61ea41 100644
--- a/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/FieldHash.xs
+++ b/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/FieldHash.xs
@@ -1,5 +1,3 @@
-#define PERL_NO_GET_CONTEXT
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -19,8 +17,7 @@ typedef struct {
 START_MY_CXT
 
 /* Inquire the object registry (a lexical hash) from perl */
-HV *
-HUF_get_ob_reg(pTHX) {
+HV* HUF_get_ob_reg(void) {
     dSP;
     HV* ob_reg = NULL;
     I32 items;
@@ -47,17 +44,16 @@ HUF_get_ob_reg(pTHX) {
 #define HUF_CLONE 0
 #define HUF_RESET -1
 
-void
-HUF_global(pTHX_ I32 how) {
+void HUF_global(I32 how) {
     if (how == HUF_INIT) {
         MY_CXT_INIT;
-        MY_CXT.ob_reg = HUF_get_ob_reg(aTHX);
+        MY_CXT.ob_reg = HUF_get_ob_reg();
     } else if (how == HUF_CLONE) {
         MY_CXT_CLONE;
-        MY_CXT.ob_reg = HUF_get_ob_reg(aTHX);
+        MY_CXT.ob_reg = HUF_get_ob_reg();
     } else if (how == HUF_RESET) {
         dMY_CXT;
-        MY_CXT.ob_reg = HUF_get_ob_reg(aTHX);
+        MY_CXT.ob_reg = HUF_get_ob_reg();
     }
 }
 
@@ -66,8 +62,7 @@ HUF_global(pTHX_ I32 how) {
 /* definition of id transformation */
 #define HUF_OBJ_ID(x) newSVuv(PTR2UV(x))
 
-SV *
-HUF_obj_id(pTHX_ SV *obj) {
+SV* HUF_obj_id(SV* obj) {
     SV *item = SvRV(obj);
     MAGIC *mg;
     SV *id;
@@ -94,9 +89,7 @@ HUF_obj_id(pTHX_ SV *obj) {
 }
 
 /* set up uvar magic for any sv */
-void
-HUF_add_uvar_magic(
-    pTHX_
+void HUF_add_uvar_magic(
     SV* sv,                    /* the sv to enchant, visible to get/set */
     I32(* val)(pTHX_ IV, SV*), /* "get" function */
     I32(* set)(pTHX_ IV, SV*), /* "set" function */
@@ -111,8 +104,7 @@ HUF_add_uvar_magic(
 }
 
 /* Fetch the data container of a trigger */
-AV *
-HUF_get_trigger_content(pTHX_ SV *trigger) {
+AV* HUF_get_trigger_content(SV* trigger) {
     MAGIC* mg;
     if (trigger && (mg = mg_find(trigger, PERL_MAGIC_uvar)))
         return (AV*)mg->mg_obj;
@@ -123,26 +115,25 @@ HUF_get_trigger_content(pTHX_ SV *trigger) {
  * the object's entry from the object registry.  This function goes in
  * the uf_set field of the uvar magic of a trigger.
  */
-I32 HUF_destroy_obj(pTHX_ IV index, SV *trigger) {
-    PERL_UNUSED_ARG(index);
+I32 HUF_destroy_obj(pTHX_ IV index, SV* trigger) {
     /* Do nothing if the weakref wasn't undef'd.  Also don't bother
      * during global destruction.  (MY_CXT.ob_reg is sometimes funny there) */
     if (!SvROK(trigger) && (!PL_in_clean_all)) {
         dMY_CXT;
-        AV* cont = HUF_get_trigger_content(aTHX_ trigger);
+        AV* cont = HUF_get_trigger_content(trigger);
         SV* ob_id = *av_fetch(cont, 0, 0);
         HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
         HE* ent;
         hv_iterinit(field_tab);
-        while ((ent = hv_iternext(field_tab))) {
+        while (ent = hv_iternext(field_tab)) {
             SV* field_ref = HeVAL(ent);
             SV* field = SvRV(field_ref);
-            (void) hv_delete_ent((HV*)field, ob_id, 0, 0);
+            hv_delete_ent((HV*)field, ob_id, 0, 0);
         }
         /* make it safe in case we must run in global clenaup, after all */
         if (PL_in_clean_all)
-            HUF_global(aTHX_ HUF_RESET); /* shoudn't be needed */
-        (void) hv_delete_ent(MY_CXT.ob_reg, ob_id, 0, 0);
+            HUF_global(HUF_RESET); /* shoudn't be needed */
+        hv_delete_ent(MY_CXT.ob_reg, ob_id, 0, 0);
     }
     return 0;
 }
@@ -155,56 +146,51 @@ I32 HUF_destroy_obj(pTHX_ IV index, SV *trigger) {
  * object may * have to be deleted.  The trigger is stored in the
  * object registry and is also deleted when the object expires.
  */
-SV *
-HUF_new_trigger(pTHX_ SV *obj, SV *ob_id) {
+SV* HUF_new_trigger(SV* obj, SV* ob_id) {
     dMY_CXT;
     SV* trigger = sv_rvweaken(newRV_inc(SvRV(obj)));
     AV* cont = newAV();
     sv_2mortal((SV*)cont);
     av_store(cont, 0, SvREFCNT_inc(ob_id));
     av_store(cont, 1, (SV*)newHV());
-    HUF_add_uvar_magic(aTHX_ trigger, NULL, &HUF_destroy_obj, 0, (SV*)cont);
-    (void) hv_store_ent(MY_CXT.ob_reg, ob_id, trigger, 0);
+    HUF_add_uvar_magic(trigger, NULL, &HUF_destroy_obj, 0, (SV*)cont);
+    hv_store_ent(MY_CXT.ob_reg, ob_id, trigger, 0);
     return trigger;
 }
 
 /* retrieve a trigger for obj if one exists, return NULL otherwise */
-SV *
-HUF_ask_trigger(pTHX_ SV *ob_id) {
+SV* HUF_ask_trigger(SV* ob_id) {
     dMY_CXT;
     HE* ent;
-    if ((ent = hv_fetch_ent(MY_CXT.ob_reg, ob_id, 0, 0)))
+    if (ent = hv_fetch_ent(MY_CXT.ob_reg, ob_id, 0, 0))
         return HeVAL(ent);
     return NULL;
 }
 
 /* get the trigger for an object, creating it if necessary */
-SV *
-HUF_get_trigger0(pTHX_ SV *obj, SV *ob_id) {
+SV* HUF_get_trigger0(SV* obj, SV* ob_id) {
     SV* trigger;
-    if (!(trigger = HUF_ask_trigger(aTHX_ ob_id)))
-        trigger = HUF_new_trigger(aTHX_ obj, ob_id);
+    if (!(trigger = HUF_ask_trigger(ob_id)))
+        trigger = HUF_new_trigger(obj, ob_id);
     return trigger;
 }
 
-SV *
-HUF_get_trigger(pTHX_ SV *obj, SV *ob_id) {
-    SV* trigger = HUF_ask_trigger(aTHX_ ob_id);
+SV* HUF_get_trigger(SV* obj, SV* ob_id) {
+    SV* trigger = HUF_ask_trigger(ob_id);
     if (!trigger)
-        trigger = HUF_new_trigger(aTHX_ obj, ob_id);
+        trigger = HUF_new_trigger(obj, ob_id);
     return( trigger);
 }
 
 /* mark an object (trigger) as having been used with a field
    (a clenup-liability)
 */
-void
-HUF_mark_field(pTHX_ SV *trigger, SV *field) {
-    AV* cont = HUF_get_trigger_content(aTHX_ trigger);
+void HUF_mark_field(SV* trigger, SV* field) {
+    AV* cont = HUF_get_trigger_content(trigger);
     HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
     SV* field_ref = newRV_inc(field);
     UV field_addr = PTR2UV(field);
-    (void) hv_store(field_tab, (char *)&field_addr, sizeof(field_addr), field_ref, 0);
+    hv_store(field_tab, (char *)&field_addr, sizeof(field_addr), field_ref, 0);
 }
 
 /* Determine, from the value of action, whether this call may create a new
@@ -218,17 +204,17 @@ I32 HUF_watch_key_safe(pTHX_ IV action, SV* field) {
     SV* keysv;
     if (mg && (keysv = mg->mg_obj)) {
         if (SvROK(keysv)) { /* ref key */
-            SV* ob_id = HUF_obj_id(aTHX_ keysv);
+            SV* ob_id = HUF_obj_id(keysv);
             mg->mg_obj = ob_id; /* key replacement */
             if (HUF_WOULD_CREATE_KEY(action)) {
-                SV* trigger = HUF_get_trigger(aTHX_ keysv, ob_id);
-                HUF_mark_field(aTHX_ trigger, field);
+                SV* trigger = HUF_get_trigger(keysv, ob_id);
+                HUF_mark_field(trigger, field);
             }
         } else if (HUF_WOULD_CREATE_KEY(action)) { /* string key */
             /* registered as object id? */
             SV* trigger;
-            if (( trigger = HUF_ask_trigger(aTHX_ keysv)))
-                HUF_mark_field(aTHX_ trigger, field);
+            if ( trigger = HUF_ask_trigger(keysv))
+                HUF_mark_field( trigger, field);
         }
     } else {
         Perl_die(aTHX_ "Rogue call of 'HUF_watch_key_safe'");
@@ -239,10 +225,9 @@ I32 HUF_watch_key_safe(pTHX_ IV action, SV* field) {
 I32 HUF_watch_key_id(pTHX_ IV action, SV* field) {
     MAGIC* mg = mg_find(field, PERL_MAGIC_uvar);
     SV* keysv;
-    PERL_UNUSED_ARG(action);
     if (mg && (keysv = mg->mg_obj)) {
         if (SvROK(keysv)) /* ref key */
-            mg->mg_obj = HUF_obj_id(aTHX_ keysv); /* key replacement */
+            mg->mg_obj = HUF_obj_id(keysv); /* key replacement */
     } else {
         Perl_die(aTHX_ "Rogue call of 'HUF_watch_key_id'");
     }
@@ -272,8 +257,7 @@ I32(* HUF_mode_2func( int mode))(pTHX_ IV, SV*) {
 }
 
 /* see if something is a field hash */
-int
-HUF_get_status(pTHX_ HV *hash) {
+int HUF_get_status(HV* hash) {
     int ans = 0;
     if (hash && (SvTYPE(hash) == SVt_PVHV)) {
         MAGIC* mg;
@@ -291,24 +275,23 @@ HUF_get_status(pTHX_ HV *hash) {
 /* Thread support.  These routines are called by CLONE (and nothing else) */
 
 /* Fix entries for one object in all field hashes */
-void
-HUF_fix_trigger(pTHX_ SV *trigger, SV *new_id) {
-    AV* cont = HUF_get_trigger_content(aTHX_ trigger);
+void HUF_fix_trigger(SV* trigger, SV* new_id) {
+    AV* cont = HUF_get_trigger_content(trigger);
     HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
     HV* new_tab = newHV();
     HE* ent;
     SV* old_id = *av_fetch(cont, 0, 0);
     hv_iterinit(field_tab);
-    while ((ent = hv_iternext(field_tab))) {
+    while (ent = hv_iternext(field_tab)) {
         SV* field_ref = HeVAL(ent);
         HV* field = (HV*)SvRV(field_ref);
         UV field_addr = PTR2UV(field);
         SV* val;
         /* recreate field tab entry */
-        (void) hv_store(new_tab, (char *)&field_addr, sizeof(field_addr), SvREFCNT_inc(field_ref), 0);
+        hv_store(new_tab, (char *)&field_addr, sizeof(field_addr), SvREFCNT_inc(field_ref), 0);
         /* recreate field entry, if any */
-        if ((val = hv_delete_ent(field, old_id, 0, 0)))
-            (void) hv_store_ent(field, new_id, SvREFCNT_inc(val), 0);
+        if (val = hv_delete_ent(field, old_id, 0, 0))
+            hv_store_ent(field, new_id, SvREFCNT_inc(val), 0);
     }
     /* update the trigger */
     av_store(cont, 0, SvREFCNT_inc(new_id));
@@ -318,16 +301,15 @@ HUF_fix_trigger(pTHX_ SV *trigger, SV *new_id) {
 /* Go over object registry and fix all objects.  Also fix the object
  * registry.
  */
-void
-HUF_fix_objects(pTHX) {
+void HUF_fix_objects(void) {
     dMY_CXT;
     I32 i, len;
     HE* ent;
     AV* oblist = (AV*)sv_2mortal((SV*)newAV());
     hv_iterinit(MY_CXT.ob_reg);
-    while((ent = hv_iternext(MY_CXT.ob_reg)))
+    while(ent = hv_iternext(MY_CXT.ob_reg))
         av_push(oblist, SvREFCNT_inc(hv_iterkeysv(ent)));
-    len = av_tindex(oblist);
+    len = av_len(oblist);
     for (i = 0; i <= len; ++i) {
         SV* old_id = *av_fetch(oblist, i, 0);
         SV* trigger = hv_delete_ent(MY_CXT.ob_reg, old_id, 0, 0);
@@ -345,8 +327,8 @@ HUF_fix_objects(pTHX) {
             }
         }
 
-        HUF_fix_trigger(aTHX_ trigger, new_id);
-        (void) hv_store_ent(MY_CXT.ob_reg, new_id, SvREFCNT_inc(trigger), 0);
+        HUF_fix_trigger(trigger, new_id);
+        hv_store_ent(MY_CXT.ob_reg, new_id, SvREFCNT_inc(trigger), 0);
     }
 }
 
@@ -354,8 +336,6 @@ HUF_fix_objects(pTHX) {
 
 static SV* counter;
 I32 HUF_inc_var(pTHX_ IV index, SV* which) {
-    PERL_UNUSED_ARG(index);
-    PERL_UNUSED_ARG(which);
     sv_setiv(counter, 1 + SvIV(counter));
     return 0;
 }
@@ -364,7 +344,7 @@ MODULE = Hash::Util::FieldHash          PACKAGE = Hash::Util::FieldHash
 
 BOOT:
 {
-    HUF_global(aTHX_ HUF_INIT); /* create variables */
+    HUF_global(HUF_INIT); /* create variables */
 }
 
 int
@@ -380,14 +360,13 @@ CODE:
     ) {
         
         HUF_add_uvar_magic(
-            aTHX_
             SvRV(href),
-            HUF_mode_2func(mode),
+            HUF_mode_2func( mode),
             NULL,
             0,
             NULL
         );
-        RETVAL = HUF_get_status(aTHX_ field);
+        RETVAL = HUF_get_status(field);
     }
 OUTPUT:
     RETVAL
@@ -397,7 +376,7 @@ id(SV* ref)
 PROTOTYPE: $
 PPCODE:
     if (SvROK(ref)) {
-        XPUSHs(HUF_obj_id(aTHX_ ref));
+        XPUSHs(HUF_obj_id(ref));
     } else {
         XPUSHs(ref);
     }
@@ -406,7 +385,7 @@ SV*
 id_2obj(SV* id)
 PROTOTYPE: $
 CODE:
-    SV* obj = HUF_ask_trigger(aTHX_ id);
+    SV* obj = HUF_ask_trigger(id);
     if (obj) {
         RETVAL = newRV_inc(SvRV(obj));
     } else {
@@ -427,11 +406,11 @@ CODE:
     } else {
         RETVAL = newRV_inc(SvRV(obj));
     }
-    trigger = HUF_get_trigger(aTHX_ obj, HUF_obj_id(aTHX_ obj));
+    trigger = HUF_get_trigger(obj, HUF_obj_id(obj));
     for (i = 1; i < items; ++ i) {
         SV* field_ref = POPs;
         if (SvROK(field_ref) && (SvTYPE(SvRV(field_ref)) == SVt_PVHV)) {
-            HUF_mark_field(aTHX_ trigger, SvRV(field_ref));
+            HUF_mark_field(trigger, SvRV(field_ref));
         }
     }
 OUTPUT:
@@ -441,22 +420,22 @@ void
 CLONE(char* classname)
 CODE:
     if (0 == strcmp(classname, "Hash::Util::FieldHash")) {
-        HUF_global(aTHX_ HUF_CLONE);
-        HUF_fix_objects(aTHX);
+        HUF_global(HUF_CLONE);
+        HUF_fix_objects();
     }
 
 void
 _active_fields(SV* obj)
 PPCODE:
     if (SvROK(obj)) {
-        SV* ob_id = HUF_obj_id(aTHX_ obj);
-        SV* trigger = HUF_ask_trigger(aTHX_ ob_id);
+        SV* ob_id = HUF_obj_id(obj);
+        SV* trigger = HUF_ask_trigger(ob_id);
         if (trigger) {
-            AV* cont = HUF_get_trigger_content(aTHX_ trigger);
+            AV* cont = HUF_get_trigger_content(trigger);
             HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
             HE* ent;
             hv_iterinit(field_tab);
-            while ((ent = hv_iternext(field_tab))) {
+            while (ent = hv_iternext(field_tab)) {
                 HV* field = (HV*)SvRV(HeVAL(ent));
                 if (hv_exists_ent(field, ob_id, 0))
                     XPUSHs(sv_2mortal(newRV_inc((SV*)field)));
@@ -466,20 +445,47 @@ PPCODE:
 
 void
 _test_uvar_get(SV* svref, SV* countref)
-ALIAS:
-_test_uvar_get = 1
-_test_uvar_set = 2
-_test_uvar_same = 3
 CODE:
     if (SvROK(svref) && SvROK(countref)) {
         counter = SvRV(countref);
         sv_setiv(counter, 0);
         HUF_add_uvar_magic(
-            aTHX_
             SvRV(svref),
-            ix & 1 ? &HUF_inc_var : 0,
-            ix & 2 ? &HUF_inc_var : 0,
-	    0,
+            &HUF_inc_var,
+            NULL,
+            0,
+            SvRV(countref)
+        );
+    }
+
+void
+_test_uvar_set(SV* svref, SV* countref)
+CODE:
+    if (SvROK(svref) && SvROK(countref)) {
+        counter = SvRV(countref);
+        sv_setiv(counter, 0);
+        counter = SvRV(countref);
+        HUF_add_uvar_magic(
+            SvRV(svref),
+            NULL,
+            &HUF_inc_var,
+            0,
             SvRV(countref)
         );
     }
+
+void
+_test_uvar_same(SV* svref, SV* countref)
+CODE:
+    if (SvROK(svref) && SvROK(countref)) {
+        counter = SvRV(countref);
+        sv_setiv(counter, 0);
+        HUF_add_uvar_magic(
+            SvRV(svref),
+            &HUF_inc_var,
+            &HUF_inc_var,
+            0,
+            NULL
+        );
+    }
+
diff --git a/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm b/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm
index 2441491fa5c..bca3a6fd7fc 100644
--- a/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm
+++ b/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/lib/Hash/Util/FieldHash.pm
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 use Scalar::Util qw( reftype);
 
-our $VERSION = '1.15';
+our $VERSION = '1.04';
 
 require Exporter;
 our @ISA = qw(Exporter);
@@ -26,7 +26,7 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
     require XSLoader;
     my %ob_reg; # private object registry
     sub _ob_reg { \ %ob_reg }
-    XSLoader::load();
+    XSLoader::load('Hash::Util::FieldHash', $VERSION);
 }
 
 sub fieldhash (\%) {
@@ -103,8 +103,7 @@ Returns the reference address of a reference $obj.  If $obj is
 not a reference, returns $obj.
 
 This function is a stand-in replacement for
-L<Scalar::Util::refaddr|Scalar::Util/"$addr = refaddr( $ref )">,
-that is, it returns
+L<Scalar::Util::refaddr|Scalar::Util/refaddr>, that is, it returns
 the reference address of its argument as a numeric value.  The only
 difference is that C<refaddr()> returns C<undef> when given a
 non-reference while C<id()> returns its argument unchanged.
@@ -218,7 +217,7 @@ in this technique, classes that can advertise themselves as "Put me
 on your @ISA list and use my methods".  If the other class has different
 ideas about how the object body is used, there is trouble.
 
-For reference C<Name_hash> in L</Example 1> shows the standard implementation of
+For reference L<Name_hash> in L<Example 1> shows the standard implementation of
 a simple class C<Name> in the well-known hash based way.  It also demonstrates
 the predictable failure to construct a common subclass C<NamedFile>
 of C<Name> and the class C<IO::File> (whose objects I<must> be globrefs).
@@ -232,8 +231,8 @@ With I<inside-out> classes, each class declares a (typically lexical)
 hash for each field it wants to use.  The reference address of an
 object is used as the hash key.  By definition, the reference address
 is unique to each object so this guarantees a place for each field that
-is private to the class and unique to each object.  See C<Name_id>
-in L</Example 1> for a simple example.
+is private to the class and unique to each object.  See L<Name_id> in
+L<Example 1> for a simple example.
 
 In comparison to the standard implementation where the object is a
 hash and the fields correspond to hash keys, here the fields correspond
@@ -324,7 +323,7 @@ make things work, but the functions or methods used by the hooks
 must be provided by each inside-out class.
 
 A general solution to the serialization problem would require another
-level of registry, one that associates I<classes> and fields.
+level of registry, one that that associates I<classes> and fields.
 So far, the functions of C<Hash::Util::FieldHash> are unaware of
 any classes, which I consider a feature.  Therefore C<Hash::Util::FieldHash>
 doesn't address the serialization problems.
@@ -495,7 +494,7 @@ class.
 
 =item * C<Name_idhash>
 
-Idhash-based inside-out implementation.  Like C<Name_id> it needs
+Idhash-based inside-out implementation.  Like L<Name_id> it needs
 a C<DESTROY> method and would need C<CLONE> for thread support.
 
 =item * C<Name_id_reg>
@@ -523,8 +522,8 @@ to a file F<Example.pm>.
     use strict; use warnings;
 
     {
-        package Name_hash;  # standard implementation: the
-                            # object is a hash
+        package Name_hash; # standard implementation: the object is a hash
+
         sub init {
             my $obj = shift;
             my ($first, $last) = @_;
@@ -715,7 +714,7 @@ incompatibility of object bodies.
 
     {
         package Name;
-        use parent 'Name_id';  # define here which implementation to run
+        use base 'Name_id';      # define here which implementation to run
     }
 
 
@@ -738,8 +737,8 @@ incompatibility of object bodies.
 
     # Definition of NamedFile
     package NamedFile;
-    use parent 'Name';
-    use parent 'IO::File';
+    use base 'Name';
+    use base 'IO::File';
 
     sub init {
         my $obj = shift;
@@ -754,7 +753,7 @@ incompatibility of object bodies.
 =head1 GUTS
 
 To make C<Hash::Util::FieldHash> work, there were two changes to
-F<perl> itself.  C<PERL_MAGIC_uvar> was made available for hashes,
+F<perl> itself.  C<PERL_MAGIC_uvar> was made avalaible for hashes,
 and weak references now call uvar C<get> magic after a weakref has been
 cleared.  The first feature is used to make field hashes intercept
 their keys upon access.  The second one triggers garbage collection.
diff --git a/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/t/05_perlhook.t b/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/t/05_perlhook.t
index 92c6b7ac4fc..3a4ebc88514 100755
--- a/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/t/05_perlhook.t
+++ b/gnu/usr.bin/perl/ext/Hash-Util-FieldHash/t/05_perlhook.t
@@ -1,4 +1,12 @@
 #!perl
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+    }
+}
+
 use strict; use warnings;
 use Test::More;
 my $n_tests;
diff --git a/gnu/usr.bin/perl/ext/Hash-Util/Util.xs b/gnu/usr.bin/perl/ext/Hash-Util/Util.xs
index 2758d69047f..571d48b5915 100644
--- a/gnu/usr.bin/perl/ext/Hash-Util/Util.xs
+++ b/gnu/usr.bin/perl/ext/Hash-Util/Util.xs
@@ -1,59 +1,107 @@
-#define PERL_NO_GET_CONTEXT
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 
+
 MODULE = Hash::Util		PACKAGE = Hash::Util
 
-void
+
+SV*
 all_keys(hash,keys,placeholder)
-	HV *hash
-	AV *keys
-	AV *placeholder
+	SV* hash
+	SV* keys
+	SV* placeholder
     PROTOTYPE: \%\@\@
     PREINIT:
+	AV* av_k;
+        AV* av_p;
+        HV* hv;
         SV *key;
         HE *he;
-    PPCODE:
-        av_clear(keys);
-        av_clear(placeholder);
-
-        (void)hv_iterinit(hash);
-	while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
+    CODE:
+	if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV)
+	   croak("First argument to all_keys() must be an HASH reference");
+	if (!SvROK(keys) || SvTYPE(SvRV(keys)) != SVt_PVAV)
+	   croak("Second argument to all_keys() must be an ARRAY reference");
+        if (!SvROK(placeholder) || SvTYPE(SvRV(placeholder)) != SVt_PVAV)
+	   croak("Third argument to all_keys() must be an ARRAY reference");
+
+	hv = (HV*)SvRV(hash);
+	av_k = (AV*)SvRV(keys);
+	av_p = (AV*)SvRV(placeholder);
+
+        av_clear(av_k);
+        av_clear(av_p);
+
+        (void)hv_iterinit(hv);
+	while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
 	    key=hv_iterkeysv(he);
-	    av_push(HeVAL(he) == &PL_sv_placeholder ? placeholder : keys,
-		    SvREFCNT_inc(key));
+            if (HeVAL(he) == &PL_sv_placeholder) {
+                SvREFCNT_inc(key);
+	        av_push(av_p, key);
+            } else {
+                SvREFCNT_inc(key);
+	        av_push(av_k, key);
+            }
         }
-	XSRETURN(1);
+        RETVAL=hash;
+
 
 void
 hidden_ref_keys(hash)
-	HV *hash
-    ALIAS:
-	Hash::Util::legal_ref_keys = 1
+	SV* hash
     PREINIT:
+        HV* hv;
         SV *key;
         HE *he;
     PPCODE:
-        (void)hv_iterinit(hash);
-	while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
+	if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV)
+	   croak("First argument to hidden_keys() must be an HASH reference");
+
+	hv = (HV*)SvRV(hash);
+
+        (void)hv_iterinit(hv);
+	while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
 	    key=hv_iterkeysv(he);
-            if (ix || HeVAL(he) == &PL_sv_placeholder) {
+            if (HeVAL(he) == &PL_sv_placeholder) {
                 XPUSHs( key );
             }
         }
 
 void
-hv_store(hash, key, val)
-	HV *hash
+legal_ref_keys(hash)
+	SV* hash
+    PREINIT:
+        HV* hv;
+        SV *key;
+        HE *he;
+    PPCODE:
+	if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV)
+	   croak("First argument to legal_keys() must be an HASH reference");
+
+	hv = (HV*)SvRV(hash);
+
+        (void)hv_iterinit(hv);
+	while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
+	    key=hv_iterkeysv(he);
+            XPUSHs( key );
+        }
+
+void
+hv_store(hvref, key, val)
+	SV* hvref
 	SV* key
 	SV* val
     PROTOTYPE: \%$$
+    PREINIT:
+	HV* hv;
     CODE:
     {
+	if (!SvROK(hvref) || SvTYPE(SvRV(hvref)) != SVt_PVHV)
+	   croak("First argument to hv_store() must be a hash reference");
+	hv = (HV*)SvRV(hvref);
         SvREFCNT_inc(val);
-	if (!hv_store_ent(hash, key, val, 0)) {
+	if (!hv_store_ent(hv, key, val, 0)) {
 	    SvREFCNT_dec(val);
 	    XSRETURN_NO;
 	} else {
@@ -61,184 +109,3 @@ hv_store(hash, key, val)
 	}
     }
 
-void
-hash_seed()
-    PROTOTYPE:
-    PPCODE:
-    mXPUSHs(newSVpvn((char *)PERL_HASH_SEED,PERL_HASH_SEED_BYTES));
-    XSRETURN(1);
-
-
-void
-hash_value(string)
-        SV* string
-    PROTOTYPE: $
-    PPCODE:
-    STRLEN len;
-    char *pv;
-    UV uv;
-
-    pv= SvPV(string,len);
-    PERL_HASH(uv,pv,len);
-    XSRETURN_UV(uv);
-
-void
-hash_traversal_mask(rhv, ...)
-        SV* rhv
-    PPCODE:
-{
-#ifdef PERL_HASH_RANDOMIZE_KEYS
-    if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        HV *hv = (HV *)SvRV(rhv);
-        if (items>1) {
-            hv_rand_set(hv, SvUV(ST(1)));
-        }
-        if (SvOOK(hv)) {
-            XSRETURN_UV(HvRAND_get(hv));
-        } else {
-            XSRETURN_UNDEF;
-        }
-    }
-#else
-    Perl_croak(aTHX_ "Perl has not been compiled with support for randomized hash key traversal");
-#endif
-}
-
-void
-bucket_info(rhv)
-        SV* rhv
-    PPCODE:
-{
-    /*
-
-    Takes a non-magical hash ref as an argument and returns a list of
-    statistics about the hash. The number and keys and the size of the
-    array will always be reported as the first two values. If the array is
-    actually allocated (they are lazily allocated), then additionally
-    will return a list of counts of bucket lengths. In other words in
-
-        ($keys, $buckets, $used, @length_count)= hash::bucket_info(\%hash);
-
-    $length_count[0] is the number of empty buckets, and $length_count[1]
-    is the number of buckets with only one key in it, $buckets - $length_count[0]
-    gives the number of used buckets, and @length_count-1 is the maximum
-    bucket depth.
-
-    If the argument is not a hash ref, or if it is magical, then returns
-    nothing (the empty list).
-
-    */
-    if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        const HV * const hv = (const HV *) SvRV(rhv);
-        U32 max_bucket_index= HvMAX(hv);
-        U32 total_keys= HvUSEDKEYS(hv);
-        HE **bucket_array= HvARRAY(hv);
-        mXPUSHi(total_keys);
-        mXPUSHi(max_bucket_index+1);
-        mXPUSHi(0); /* for the number of used buckets */
-#define BUCKET_INFO_ITEMS_ON_STACK 3
-        if (!bucket_array) {
-            XSRETURN(BUCKET_INFO_ITEMS_ON_STACK);
-        } else {
-            /* we use chain_length to index the stack - we eliminate an add
-             * by initializing things with the number of items already on the stack.
-             * If we have 2 items then ST(2+0) (the third stack item) will be the counter
-             * for empty chains, ST(2+1) will be for chains with one element,  etc.
-             */
-            I32 max_chain_length= BUCKET_INFO_ITEMS_ON_STACK - 1; /* so we do not have to do an extra push for the 0 index */
-            HE *he;
-            U32 bucket_index;
-            for ( bucket_index= 0; bucket_index <= max_bucket_index; bucket_index++ ) {
-                I32 chain_length= BUCKET_INFO_ITEMS_ON_STACK;
-                for (he= bucket_array[bucket_index]; he; he= HeNEXT(he) ) {
-                    chain_length++;
-                }
-                while ( max_chain_length < chain_length ) {
-                    mXPUSHi(0);
-                    max_chain_length++;
-                }
-                SvIVX( ST( chain_length ) )++;
-            }
-            /* now set the number of used buckets */
-            SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK - 1 ) ) = max_bucket_index - SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK ) ) + 1;
-            XSRETURN( max_chain_length + 1 ); /* max_chain_length is the index of the last item on the stack, so we add 1 */
-        }
-#undef BUCKET_INFO_ITEMS_ON_STACK
-    }
-    XSRETURN(0);
-}
-
-void
-bucket_array(rhv)
-        SV* rhv
-    PPCODE:
-{
-    /* Returns an array of arrays representing key/bucket mappings.
-     * Each element of the array contains either an integer or a reference
-     * to an array of keys. A plain integer represents K empty buckets. An
-     * array ref represents a single bucket, with each element being a key in
-     * the hash. (Note this treats a placeholder as a normal key.)
-     *
-     * This allows one to "see" the keyorder. Note the "insert first" nature
-     * of the hash store, combined with regular remappings means that relative
-     * order of keys changes each remap.
-     */
-    if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        const HV * const hv = (const HV *) SvRV(rhv);
-        HE **he_ptr= HvARRAY(hv);
-        if (!he_ptr) {
-            XSRETURN(0);
-        } else {
-            U32 i, max;
-            AV *info_av;
-            HE *he;
-            I32 empty_count=0;
-            if (SvMAGICAL(hv)) {
-                Perl_croak(aTHX_ "hash::bucket_array only works on 'normal' hashes");
-            }
-            info_av= newAV();
-            max= HvMAX(hv);
-            mXPUSHs(newRV_noinc((SV*)info_av));
-            for ( i= 0; i <= max; i++ ) {
-                AV *key_av= NULL;
-                for (he= he_ptr[i]; he; he= HeNEXT(he) ) {
-                    SV *key_sv;
-                    char *str;
-                    STRLEN len;
-                    char mode;
-                    if (!key_av) {
-                        key_av= newAV();
-                        if (empty_count) {
-                            av_push(info_av, newSViv(empty_count));
-                            empty_count= 0;
-                        }
-                        av_push(info_av, (SV *)newRV_noinc((SV *)key_av));
-                    }
-                    if (HeKLEN(he) == HEf_SVKEY) {
-                        SV *sv= HeSVKEY(he);
-                        SvGETMAGIC(sv);
-                        str= SvPV(sv, len);
-                        mode= SvUTF8(sv) ? 1 : 0;
-                    } else {
-                        str= HeKEY(he);
-                        len= HeKLEN(he);
-                        mode= HeKUTF8(he) ? 1 : 0;
-                    }
-                    key_sv= newSVpvn(str,len);
-                    av_push(key_av,key_sv);
-                    if (mode) {
-                        SvUTF8_on(key_sv);
-                    }
-                }
-                if (!key_av)
-                    empty_count++;
-            }
-            if (empty_count) {
-                av_push(info_av, newSViv(empty_count));
-                empty_count++;
-            }
-        }
-        XSRETURN(1);
-    }
-    XSRETURN(0);
-}
diff --git a/gnu/usr.bin/perl/ext/Hash-Util/lib/Hash/Util.pm b/gnu/usr.bin/perl/ext/Hash-Util/lib/Hash/Util.pm
index 8ae25d14d97..0fa14690243 100644
--- a/gnu/usr.bin/perl/ext/Hash-Util/lib/Hash/Util.pm
+++ b/gnu/usr.bin/perl/ext/Hash-Util/lib/Hash/Util.pm
@@ -4,7 +4,6 @@ require 5.007003;
 use strict;
 use Carp;
 use warnings;
-no warnings 'uninitialized';
 use warnings::register;
 use Scalar::Util qw(reftype);
 
@@ -17,26 +16,22 @@ our @EXPORT_OK  = qw(
                      lock_keys unlock_keys
                      lock_value unlock_value
                      lock_hash unlock_hash
-                     lock_keys_plus
-                     hash_locked hash_unlocked
-                     hashref_locked hashref_unlocked
+                     lock_keys_plus hash_locked
                      hidden_keys legal_keys
 
                      lock_ref_keys unlock_ref_keys
                      lock_ref_value unlock_ref_value
                      lock_hashref unlock_hashref
-                     lock_ref_keys_plus
+                     lock_ref_keys_plus hashref_locked
                      hidden_ref_keys legal_ref_keys
 
-                     hash_seed hash_value hv_store
-                     bucket_stats bucket_info bucket_array
-                     lock_hash_recurse unlock_hash_recurse
+                     hash_seed hv_store
 
-                     hash_traversal_mask
                     );
-our $VERSION = '0.16';
-require XSLoader;
-XSLoader::load();
+our $VERSION    = 0.07;
+require DynaLoader;
+local @ISA = qw(DynaLoader);
+bootstrap Hash::Util $VERSION;
 
 sub import {
     my $class = shift;
@@ -58,28 +53,12 @@ Hash::Util - A selection of general-utility hash subroutines
   # Restricted hashes
 
   use Hash::Util qw(
-                     fieldhash fieldhashes
-
-                     all_keys
+                     hash_seed all_keys
                      lock_keys unlock_keys
                      lock_value unlock_value
                      lock_hash unlock_hash
-                     lock_keys_plus
-                     hash_locked hash_unlocked
-                     hashref_locked hashref_unlocked
+                     lock_keys_plus hash_locked
                      hidden_keys legal_keys
-
-                     lock_ref_keys unlock_ref_keys
-                     lock_ref_value unlock_ref_value
-                     lock_hashref unlock_hashref
-                     lock_ref_keys_plus
-                     hidden_ref_keys legal_ref_keys
-
-                     hash_seed hash_value hv_store
-                     bucket_stats bucket_info bucket_array
-                     lock_hash_recurse unlock_hash_recurse
-
-                     hash_traversal_mask
                    );
 
   %hash = (foo => 42, bar => 23);
@@ -107,12 +86,6 @@ Hash::Util - A selection of general-utility hash subroutines
 
   my $hashes_are_randomised = hash_seed() != 0;
 
-  my $int_hash_value = hash_value( 'string' );
-
-  my $mask= hash_traversal_mask(%hash);
-
-  hash_traversal_mask(%hash,1234);
-
 =head1 DESCRIPTION
 
 C<Hash::Util> and C<Hash::Util::FieldHash> contain special functions
@@ -156,8 +129,8 @@ the hash before you call lock_keys() so this shouldn't be a problem.
 
 Removes the restriction on the %hash's keyset.
 
-B<Note> that if any of the values of the hash have been locked they will not
-be unlocked after this sub executes.
+B<Note> that if any of the values of the hash have been locked they will not be unlocked
+after this sub executes.
 
 Both routines return a reference to the hash operated on.
 
@@ -217,7 +190,7 @@ Returns a reference to %hash
 
 
 sub lock_ref_keys_plus {
-    my ($hash,@keys) = @_;
+    my ($hash,@keys)=@_;
     my @delete;
     Internals::hv_clear_placeholders(%$hash);
     foreach my $key (@keys) {
@@ -328,9 +301,9 @@ lock_hash() locks an entire hash and any hashes it references recursively,
 making all keys and values read-only. No value can be changed, no keys can
 be added or deleted.
 
-This method B<only> recurses into hashes that are referenced by another hash.
-Thus a Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of
-Hashes (HoAoH) will only have the top hash restricted.
+B<Only> recurses into hashes that are referenced by another hash. Thus a
+Hash of Hashes (HoH) will all be restricted, but a Hash of Arrays of Hashes
+(HoAoH) will only have the top hash restricted.
 
     unlock_hash_recurse(%hash);
 
@@ -347,8 +320,7 @@ sub lock_hashref_recurse {
 
     lock_ref_keys($hash);
     foreach my $value (values %$hash) {
-        my $type = reftype($value);
-        if (defined($type) and $type eq 'HASH') {
+        if (reftype($value) eq 'HASH') {
             lock_hashref_recurse($value);
         }
         Internals::SvREADONLY($value,1);
@@ -360,8 +332,7 @@ sub unlock_hashref_recurse {
     my $hash = shift;
 
     foreach my $value (values %$hash) {
-        my $type = reftype($value);
-        if (defined($type) and $type eq 'HASH') {
+        if (reftype($value) eq 'HASH') {
             unlock_hashref_recurse($value);
         }
         Internals::SvREADONLY($value,1);
@@ -373,29 +344,9 @@ sub unlock_hashref_recurse {
 sub   lock_hash_recurse (\%) {   lock_hashref_recurse(@_) }
 sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
 
-=item B<hashref_locked>
-
-=item B<hash_locked>
-
-  hashref_locked(\%hash) and print "Hash is locked!\n";
-  hash_locked(%hash) and print "Hash is locked!\n";
-
-Returns true if the hash and its keys are locked.
-
-=cut
-
-sub hashref_locked {
-    my $hash=shift;
-    Internals::SvREADONLY(%$hash);
-}
-
-sub hash_locked(\%) { hashref_locked(@_) }
-
-=item B<hashref_unlocked>
 
 =item B<hash_unlocked>
 
-  hashref_unlocked(\%hash) and print "Hash is unlocked!\n";
   hash_unlocked(%hash) and print "Hash is unlocked!\n";
 
 Returns true if the hash and its keys are unlocked.
@@ -404,7 +355,7 @@ Returns true if the hash and its keys are unlocked.
 
 sub hashref_unlocked {
     my $hash=shift;
-    !Internals::SvREADONLY(%$hash);
+    return Internals::SvREADONLY($hash)
 }
 
 sub hash_unlocked(\%) { hashref_unlocked(@_) }
@@ -471,7 +422,9 @@ unrestricted hash.
 
     my $hash_seed = hash_seed();
 
-hash_seed() returns the seed bytes used to randomise hash ordering.
+hash_seed() returns the seed number used to randomise hash ordering.
+Zero means the "traditional" random hash ordering, non-zero means the
+new even more random hash ordering introduced in Perl 5.8.1.
 
 B<Note that the hash seed is sensitive information>: by knowing it one
 can craft a denial-of-service attack against Perl code, even remotely,
@@ -479,121 +432,10 @@ see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
 B<Do not disclose the hash seed> to people who don't need to know it.
 See also L<perlrun/PERL_HASH_SEED_DEBUG>.
 
-Prior to Perl 5.17.6 this function returned a UV, it now returns a string,
-which may be of nearly any size as determined by the hash function your
-Perl has been built with. Possible sizes may be but are not limited to
-4 bytes (for most hash algorithms) and 16 bytes (for siphash).
-
-=item B<hash_value>
-
-    my $hash_value = hash_value($string);
-
-hash_value() returns the current perl's internal hash value for a given
-string.
-
-Returns a 32 bit integer representing the hash value of the string passed
-in. This value is only reliable for the lifetime of the process. It may
-be different depending on invocation, environment variables,  perl version,
-architectures, and build options.
-
-B<Note that the hash value of a given string is sensitive information>:
-by knowing it one can deduce the hash seed which in turn can allow one to
-craft a denial-of-service attack against Perl code, even remotely,
-see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
-B<Do not disclose the hash value of a string> to people who don't need to
-know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>.
-
-=item B<bucket_info>
-
-Return a set of basic information about a hash.
-
-    my ($keys, $buckets, $used, @length_counts)= bucket_info($hash);
-
-Fields are as follows:
-
-    0: Number of keys in the hash
-    1: Number of buckets in the hash
-    2: Number of used buckets in the hash
-    rest : list of counts, Kth element is the number of buckets
-           with K keys in it.
-
-See also bucket_stats() and bucket_array().
-
-=item B<bucket_stats>
-
-Returns a list of statistics about a hash.
-
-    my ($keys, buckets, $used, $utilization_ratio, $collision_pct,
-        $mean, $stddev, @length_counts) = bucket_info($hashref);
-
-
-Fields are as follows:
-
-
-    0: Number of keys in the hash
-    1: Number of buckets in the hash
-    2: Number of used buckets in the hash
-    3: Hash Quality Score
-    4: Percent of buckets used
-    5: Percent of keys which are in collision
-    6: Average bucket length
-    7: Standard Deviation of bucket lengths.
-    rest : list of counts, Kth element is the number of buckets
-           with K keys in it.
-
-See also bucket_info() and bucket_array().
-
-Note that Hash Quality Score would be 1 for an ideal hash, numbers
-close to and below 1 indicate good hashing, and number significantly
-above indicate a poor score. In practice it should be around 0.95 to 1.05.
-It is defined as:
-
- $score= sum( $count[$length] * ($length * ($length + 1) / 2) )
-            /
-            ( ( $keys / 2 * $buckets ) *
-              ( $keys + ( 2 * $buckets ) - 1 ) )
-
-The formula is from the Red Dragon book (reformulated to use the data available)
-and is documented at L<http://www.strchr.com/hash_functions>
-
-=item B<bucket_array>
-
-    my $array= bucket_array(\%hash);
-
-Returns a packed representation of the bucket array associated with a hash. Each element
-of the array is either an integer K, in which case it represents K empty buckets, or
-a reference to another array which contains the keys that are in that bucket.
-
-B<Note that the information returned by bucket_array is sensitive information>:
-by knowing it one can directly attack perl's hash function which in turn may allow
-one to craft a denial-of-service attack against Perl code, even remotely,
-see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
-B<Do not disclose the output of this function> to people who don't need to
-know it. See also L<perlrun/PERL_HASH_SEED_DEBUG>. This function is provided strictly
-for  debugging and diagnostics purposes only, it is hard to imagine a reason why it
-would be used in production code.
-
 =cut
 
-
-sub bucket_stats {
-    my ($hash) = @_;
-    my ($keys, $buckets, $used, @length_counts) = bucket_info($hash);
-    my $sum;
-    my $score;
-    for (0 .. $#length_counts) {
-        $sum += ($length_counts[$_] * $_);
-        $score += $length_counts[$_] * ( $_ * ($_ + 1 ) / 2 );
-    }
-    $score = $score /
-             (( $keys / (2 * $buckets )) * ( $keys + ( 2 * $buckets ) - 1 ))
-                 if $keys;
-    my $mean= $sum/$buckets;
-    $sum= 0;
-    $sum += ($length_counts[$_] * (($_-$mean)**2)) for 0 .. $#length_counts;
-
-    my $stddev= sqrt($sum/$buckets);
-    return $keys, $buckets, $used, $keys ? ($score, $used/$buckets, ($keys-$used)/$keys, $mean, $stddev, @length_counts) : ();
+sub hash_seed () {
+    Internals::rehash_seed();
 }
 
 =item B<hv_store>
@@ -605,20 +447,6 @@ sub bucket_stats {
 
 Stores an alias to a variable in a hash instead of copying the value.
 
-=item B<hash_traversal_mask>
-
-As of Perl 5.18 every hash has its own hash traversal order, and this order
-changes every time a new element is inserted into the hash. This functionality
-is provided by maintaining an unsigned integer mask (U32) which is xor'ed
-with the actual bucket id during a traversal of the hash buckets using keys(),
-values() or each().
-
-You can use this subroutine to get and set the traversal mask for a specific
-hash. Setting the mask ensures that a given hash will produce the same key
-order. B<Note> that this does B<not> guarantee that B<two> hashes will produce
-the same key order for the same hash seed and traversal mask, items that
-collide into one bucket may have different orders regardless of this setting.
-
 =back
 
 =head2 Operating on references to hashes.
diff --git a/gnu/usr.bin/perl/ext/Hash-Util/t/Util.t b/gnu/usr.bin/perl/ext/Hash-Util/t/Util.t
index 2e9e3337e33..7a52e8c79a2 100755
--- a/gnu/usr.bin/perl/ext/Hash-Util/t/Util.t
+++ b/gnu/usr.bin/perl/ext/Hash-Util/t/Util.t
@@ -2,8 +2,10 @@
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
+	chdir 't' if -d 't';
+	@INC = '../lib';
 	require Config; import Config;
-	no warnings 'once';
+	keys %Config; # Silence warning
 	if ($Config{extensions} !~ /\bHash\/Util\b/) {
 	    print "1..0 # Skip: Hash::Util was not built\n";
 	    exit 0;
@@ -16,28 +18,22 @@ use Test::More;
 my @Exported_Funcs;
 BEGIN {
     @Exported_Funcs = qw(
-                     fieldhash fieldhashes
-
-                     all_keys
+                     hash_seed all_keys
                      lock_keys unlock_keys
                      lock_value unlock_value
                      lock_hash unlock_hash
-                     lock_keys_plus
-                     hash_locked hash_unlocked
-                     hashref_locked hashref_unlocked
+                     lock_keys_plus hash_locked
                      hidden_keys legal_keys
 
                      lock_ref_keys unlock_ref_keys
                      lock_ref_value unlock_ref_value
                      lock_hashref unlock_hashref
-                     lock_ref_keys_plus
+                     lock_ref_keys_plus hashref_locked
                      hidden_ref_keys legal_ref_keys
-
-                     hash_seed hash_value bucket_stats bucket_info bucket_array
                      hv_store
-                     lock_hash_recurse unlock_hash_recurse
+
                     );
-    plan tests => 236 + @Exported_Funcs;
+    plan tests => 204 + @Exported_Funcs;
     use_ok 'Hash::Util', @Exported_Funcs;
 }
 foreach my $func (@Exported_Funcs) {
@@ -49,7 +45,7 @@ lock_keys(%hash);
 eval { $hash{baz} = 99; };
 like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/,
                                                        'lock_keys()');
-is( $hash{bar}, 23, '$hash{bar} == 23' );
+is( $hash{bar}, 23 );
 ok( !exists $hash{baz},'!exists $hash{baz}' );
 
 delete $hash{bar};
@@ -76,7 +72,7 @@ like( $@, qr/^Attempt to delete readonly key 'locked' from a restricted hash/,
 eval { $hash{locked} = 42; };
 like( $@, qr/^Modification of a read-only value attempted/,
                                            'trying to change a locked key' );
-is( $hash{locked}, 'yep', '$hash{locked} is yep' );
+is( $hash{locked}, 'yep' );
 
 eval { delete $hash{I_dont_exist} };
 like( $@, qr/^Attempt to delete disallowed key 'I_dont_exist' from a restricted hash/,
@@ -114,23 +110,24 @@ is( $hash{locked}, 42,  'unlock_value' );
     lock_value(%hash, 'RO');
 
     eval { %hash = (KEY => 1) };
-    like( $@, qr/^Attempt to delete readonly key 'RO' from a restricted hash/,
-        'attempt to delete readonly key from restricted hash' );
+    like( $@, qr/^Attempt to delete readonly key 'RO' from a restricted hash/ );
 }
 
 {
     my %hash = (KEY => 1, RO => 2);
     lock_keys(%hash);
     eval { %hash = (KEY => 1, RO => 2) };
-    is( $@, '', 'No error message, as expected');
+    is( $@, '');
 }
 
+
+
 {
     my %hash = ();
     lock_keys(%hash, qw(foo bar));
     is( keys %hash, 0,  'lock_keys() w/keyset shouldnt add new keys' );
     $hash{foo} = 42;
-    is( keys %hash, 1, '1 element in hash' );
+    is( keys %hash, 1 );
     eval { $hash{wibble} = 42 };
     like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
                         'write threw error (locked)');
@@ -140,6 +137,7 @@ is( $hash{locked}, 42,  'unlock_value' );
     is( $@, '', 'unlock_keys' );
 }
 
+
 {
     my %hash = (foo => 42, bar => undef, baz => 0);
     lock_keys(%hash, qw(foo bar baz up down));
@@ -154,50 +152,35 @@ is( $hash{locked}, 42,  'unlock_value' );
           'locked "wibble"' );
 }
 
+
 {
     my %hash = (foo => 42, bar => undef);
     eval { lock_keys(%hash, qw(foo baz)); };
-    like( $@, qr/^Hash has key 'bar' which is not in the new key set/,
+    is( $@, sprintf("Hash has key 'bar' which is not in the new key ".
+                    "set at %s line %d\n", __FILE__, __LINE__ - 2),
                     'carp test' );
 }
 
+
 {
     my %hash = (foo => 42, bar => 23);
     lock_hash( %hash );
-    ok( hashref_locked( \%hash ), 'hashref_locked' );
-    ok( hash_locked( %hash ), 'hash_locked' );
 
     ok( Internals::SvREADONLY(%hash),'Was locked %hash' );
     ok( Internals::SvREADONLY($hash{foo}),'Was locked $hash{foo}' );
     ok( Internals::SvREADONLY($hash{bar}),'Was locked $hash{bar}' );
 
     unlock_hash ( %hash );
-    ok( hashref_unlocked( { %hash } ), 'hashref_unlocked' );
-    ok( hash_unlocked( %hash ), 'hash_unlocked' );
 
     ok( !Internals::SvREADONLY(%hash),'Was unlocked %hash' );
     ok( !Internals::SvREADONLY($hash{foo}),'Was unlocked $hash{foo}' );
     ok( !Internals::SvREADONLY($hash{bar}),'Was unlocked $hash{bar}' );
 }
 
-{
-    my %hash = (foo => 42, bar => 23);
-    ok( ! hashref_locked( { %hash } ), 'hashref_locked negated' );
-    ok( ! hash_locked( %hash ), 'hash_locked negated' );
-
-    lock_hash( %hash );
-    ok( ! hashref_unlocked( \%hash ), 'hashref_unlocked negated' );
-    ok( ! hash_unlocked( %hash ), 'hash_unlocked negated' );
-}
 
 lock_keys(%ENV);
 eval { () = $ENV{I_DONT_EXIST} };
-like(
-    $@,
-    qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,
-    'locked %ENV'
-);
-unlock_keys(%ENV); # Test::Builder cannot print test failures otherwise
+like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,   'locked %ENV');
 
 {
     my %hash;
@@ -327,20 +310,8 @@ unlock_keys(%ENV); # Test::Builder cannot print test failures otherwise
     ok(keys(%hash) == 0, 'clear empty lock_keys() hash');
 }
 
-# Copy-on-write scalars should not be deletable after lock_hash;
-{
-    my %hash = (key=>__PACKAGE__);
-    lock_hash(%hash);
-    eval { delete $hash{key} };
-    like $@, qr/^Attempt to delete readonly key /,
-        'COW scalars are not exempt from lock_hash (delete)';
-    eval { %hash = () };
-    like $@, qr/^Attempt to delete readonly key /,
-        'COW scalars are not exempt from lock_hash (clear)';
-}
-
 my $hash_seed = hash_seed();
-ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
+ok($hash_seed >= 0, "hash_seed $hash_seed");
 
 {
     package Minder;
@@ -471,17 +442,6 @@ ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
     is("@keys","0 2 4 6 8",'lock_ref_keys_plus() @keys DDS/t');
 }
 {
-    my %hash=(0..9, 'a' => 'alpha');
-    lock_ref_keys_plus(\%hash,'a'..'f');
-    ok(Internals::SvREADONLY(%hash),'lock_ref_keys_plus args overlap');
-    my @hidden=sort(hidden_keys(%hash));
-    my @legal=sort(legal_keys(%hash));
-    my @keys=sort(keys(%hash));
-    is("@hidden","b c d e f",'lock_ref_keys_plus() @hidden overlap');
-    is("@legal","0 2 4 6 8 a b c d e f",'lock_ref_keys_plus() @legal overlap');
-    is("@keys","0 2 4 6 8 a",'lock_ref_keys_plus() @keys overlap');
-}
-{
     my %hash=(0..9);
     lock_keys_plus(%hash,'a'..'f');
     ok(Internals::SvREADONLY(%hash),'lock_keys_plus args DDS/t');
@@ -492,17 +452,6 @@ ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
     is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal DDS/t 3');
     is("@keys","0 2 4 6 8",'lock_keys_plus() @keys DDS/t 3');
 }
-{
-    my %hash=(0..9, 'a' => 'alpha');
-    lock_keys_plus(%hash,'a'..'f');
-    ok(Internals::SvREADONLY(%hash),'lock_keys_plus args overlap non-ref');
-    my @hidden=sort(hidden_keys(%hash));
-    my @legal=sort(legal_keys(%hash));
-    my @keys=sort(keys(%hash));
-    is("@hidden","b c d e f",'lock_keys_plus() @hidden overlap non-ref');
-    is("@legal","0 2 4 6 8 a b c d e f",'lock_keys_plus() @legal overlap non-ref');
-    is("@keys","0 2 4 6 8 a",'lock_keys_plus() @keys overlap non-ref');
-}
 
 {
     my %hash = ('a'..'f');
@@ -521,49 +470,3 @@ ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed");
     is_deeply(\@ph, \@bam, "Placeholders in place");
 }
 
-{
-    my %hash = (
-        a   => 'alpha',
-        b   => [ qw( beta gamma delta ) ],
-        c   => [ 'epsilon', { zeta => 'eta' }, ],
-        d   => { theta => 'iota' },
-    );
-    lock_hash_recurse(%hash);
-    ok( hash_locked(%hash),
-        "lock_hash_recurse(): top-level hash locked" );
-    ok( hash_locked(%{$hash{d}}),
-        "lock_hash_recurse(): element which is hashref locked" );
-    ok( ! hash_locked(%{$hash{c}[1]}),
-        "lock_hash_recurse(): element which is hashref in array ref not locked" );
-
-    unlock_hash_recurse(%hash);
-    ok( hash_unlocked(%hash),
-        "unlock_hash_recurse(): top-level hash unlocked" );
-    ok( hash_unlocked(%{$hash{d}}),
-        "unlock_hash_recurse(): element which is hashref unlocked" );
-    ok( hash_unlocked(%{$hash{c}[1]}),
-        "unlock_hash_recurse(): element which is hashref in array ref not locked" );
-}
-
-{
-    my $h1= hash_value("foo");
-    my $h2= hash_value("bar");
-    is( $h1, hash_value("foo") );
-    is( $h2, hash_value("bar") );
-}
-{
-    my @info1= bucket_info({});
-    my @info2= bucket_info({1..10});
-    my @stats1= bucket_stats({});
-    my @stats2= bucket_stats({1..10});
-    my $array1= bucket_array({});
-    my $array2= bucket_array({1..10});
-    is("@info1","0 8 0");
-    is("@info2[0,1]","5 8");
-    is("@stats1","0 8 0");
-    is("@stats2[0,1]","5 8");
-    my @keys1= sort map { ref $_ ? @$_ : () } @$array1;
-    my @keys2= sort map { ref $_ ? @$_ : () } @$array2;
-    is("@keys1","");
-    is("@keys2","1 3 5 7 9");
-}
diff --git a/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm b/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm
index 8bca1113058..cebff73fb2d 100644
--- a/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm
+++ b/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm
@@ -6,9 +6,10 @@ use warnings;
 use Carp;
 
 require Exporter;
-require XSLoader;
+require DynaLoader;
+use AutoLoader;
 
-our @ISA = qw(Exporter);
+our @ISA = qw(Exporter DynaLoader);
 
 our @EXPORT = qw(langinfo);
 
@@ -72,9 +73,32 @@ our @EXPORT_OK = qw(
 	YESSTR
 );
 
-our $VERSION = '0.11';
-
-XSLoader::load();
+our $VERSION = '0.02';
+
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.
+
+    my $constname;
+    our $AUTOLOAD;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    croak "&I18N::Langinfo::constant not defined" if $constname eq 'constant';
+    my ($error, $val) = constant($constname);
+    if ($error) { croak $error; }
+    {
+	no strict 'refs';
+	# Fixed between 5.005_53 and 5.005_61
+#XXX	if ($] >= 5.00561) {
+#XXX	    *$AUTOLOAD = sub () { $val };
+#XXX	}
+#XXX	else {
+	    *$AUTOLOAD = sub { $val };
+#XXX	}
+    }
+    goto &$AUTOLOAD;
+}
+
+bootstrap I18N::Langinfo $VERSION;
 
 1;
 __END__
@@ -103,8 +127,7 @@ answers for a yes/no question in the current locale.
 
     use I18N::Langinfo qw(langinfo ABDAY_1 YESSTR NOSTR);
 
-    my ($abday_1, $yesstr, $nostr) =
-        map { langinfo($_) } (ABDAY_1, YESSTR, NOSTR);
+    my ($abday_1, $yesstr, $nostr) = map { langinfo } qw(ABDAY_1 YESSTR NOSTR);
 
     print "$abday_1? [$yesstr/$nostr] ";
 
@@ -170,7 +193,7 @@ you can wrap the import in an eval like this:
 
 =head2 EXPORT
 
-By default only the C<langinfo()> function is exported.
+Nothing is exported by default.
 
 =head1 SEE ALSO
 
diff --git a/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.xs b/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.xs
index 8b1fd5a4ef0..c1da9818c11 100644
--- a/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.xs
+++ b/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.xs
@@ -1,5 +1,3 @@
-#define PERL_NO_GET_CONTEXT
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -20,10 +18,16 @@ INCLUDE: const-xs.inc
 SV*
 langinfo(code)
 	int	code
-  PROTOTYPE: _
   CODE:
 #ifdef HAS_NL_LANGINFO
-	RETVAL = newSVpv(nl_langinfo(code), 0);
+	{
+	  char *s;
+
+	  if ((s = nl_langinfo(code)))
+	      RETVAL = newSVpvn(s, strlen(s));
+	  else
+	      RETVAL = &PL_sv_undef;
+	}
 #else
 	croak("nl_langinfo() not implemented on this architecture");
 #endif
diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm
index 8d39ed9a205..f50c9c7b6f6 100644
--- a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm
+++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm
@@ -1,7 +1,7 @@
 package PerlIO::encoding;
 
 use strict;
-our $VERSION = '0.18';
+our $VERSION = '0.11';
 our $DEBUG = 0;
 $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
 
@@ -10,8 +10,8 @@ $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
 #
 # use Encode ();
 
-require XSLoader;
-XSLoader::load();
+use XSLoader ();
+XSLoader::load(__PACKAGE__, $VERSION);
 
 our $fallback =
     Encode::PERLQQ()|Encode::WARN_ON_ERR()|Encode::STOP_AT_PARTIAL();
diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t
index 6b4d3d068a6..f36680e46b0 100755
--- a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t
+++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/encoding.t
@@ -1,6 +1,11 @@
 #!./perl -w
 
 BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    no warnings; # Need global -w flag for later tests, but don't want this
+    # to warn here:
+    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
     unless (find PerlIO::Layer 'perlio') {
 	print "1..0 # Skip: not perlio\n";
 	exit 0;
@@ -11,7 +16,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 24;
+print "1..15\n";
 
 my $grk = "grk$$";
 my $utf = "utf$$";
@@ -28,9 +33,12 @@ if (open(GRK, ">$grk")) {
 }
 
 {
-    is(open(my $i,'<:encoding(iso-8859-7)',$grk), 1);
-    is(open(my $o,'>:utf8',$utf), 1);
-    is((print $o readline $i), 1);
+    open(my $i,'<:encoding(iso-8859-7)',$grk);
+    print "ok 1\n";
+    open(my $o,'>:utf8',$utf);
+    print "ok 2\n";
+    print $o readline($i);
+    print "ok 3\n";
     close($o) or die "Could not close: $!";
     close($i);
 }
@@ -39,58 +47,93 @@ if (open(UTF, "<$utf")) {
     binmode(UTF, ":bytes");
     if (ord('A') == 193) { # EBCDIC
 	# alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3)
-	is(scalar <UTF>, "\xb4\x58\xb4\x59\xb4\x62");
+	print "not " unless <UTF> eq "\xb4\x58\xb4\x59\xb4\x62";
     } else {
 	# alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
-	is(scalar <UTF>, "\xce\xb1\xce\xb2\xce\xb3");
+	print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3";
     }
+    print "ok 4\n";
     close UTF;
 }
 
 {
     use Encode;
-    is (open(my $i,'<:utf8',$utf), 1);
-    is (open(my $o,'>:encoding(iso-8859-7)',$grk), 1);
-    is ((scalar print $o readline $i), 1);
+    open(my $i,'<:utf8',$utf);
+    print "ok 5\n";
+    open(my $o,'>:encoding(iso-8859-7)',$grk);
+    print "ok 6\n";
+    print $o readline($i);
+    print "ok 7\n";
     close($o) or die "Could not close: $!";
     close($i);
 }
 
 if (open(GRK, "<$grk")) {
     binmode(GRK, ":bytes");
-    is(scalar <GRK>, "\xe1\xe2\xe3");
+    print "not " unless <GRK> eq "\xe1\xe2\xe3";
+    print "ok 8\n";
     close GRK;
 }
 
 $SIG{__WARN__} = sub {$warn .= $_[0]};
 
-is (open(FAIL, ">:encoding(NoneSuch)", $fail1), undef, 'Open should fail');
-like($warn, qr/^Cannot find encoding "NoneSuch" at/);
-
-is(open(RUSSKI, ">$russki"), 1);
-print RUSSKI "\x3c\x3f\x78";
-close RUSSKI or die "Could not close: $!";
-open(RUSSKI, "$russki");
-binmode(RUSSKI, ":raw");
-my $buf1;
-read(RUSSKI, $buf1, 1);
-# eof(RUSSKI);
-binmode(RUSSKI, ":encoding(koi8-r)");
-my $buf2;
-read(RUSSKI, $buf2, 1);
-my $offset = tell(RUSSKI);
-is(ord $buf1, 0x3c);
-is(ord $buf2, (ord('A') == 193) ? 0x6f : 0x3f);
-is($offset, 2);
-close RUSSKI;
+if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) {
+    print "not ok 9 # Open should fail\n";
+} else {
+    print "ok 9\n";
+}
+if (!defined $warn) {
+    print "not ok 10 # warning is undef\n";
+} elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) {
+    print "ok 10\n";
+} else {
+    print "not ok 10 # warning is '$warn'";
+}
+
+if (open(RUSSKI, ">$russki")) {
+    print RUSSKI "\x3c\x3f\x78";
+    close RUSSKI or die "Could not close: $!";
+    open(RUSSKI, "$russki");
+    binmode(RUSSKI, ":raw");
+    my $buf1;
+    read(RUSSKI, $buf1, 1);
+    # eof(RUSSKI);
+    binmode(RUSSKI, ":encoding(koi8-r)");
+    my $buf2;
+    read(RUSSKI, $buf2, 1);
+    my $offset = tell(RUSSKI);
+    if (ord($buf1) == 0x3c &&
+	ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f &&
+	$offset == 2) {
+	print "ok 11\n";
+    } else {
+	printf "not ok 11 # [%s] [%s] %d\n",
+	       join(" ", unpack("H*", $buf1)),
+	       join(" ", unpack("H*", $buf2)), $offset;
+    }
+    close(RUSSKI);
+} else {
+    print "not ok 11 # open failed: $!\n";
+}
 
 undef $warn;
 
 # Check there is no Use of uninitialized value in concatenation (.) warning
 # due to the way @latin2iso_num was used to make aliases.
-is(open(FAIL, ">:encoding(latin42)", $fail2), undef, 'Open should fail');
-
-like($warn, qr/^Cannot find encoding "latin42" at.*line \d+\.$/);
+if (open(FAIL, ">:encoding(latin42)", $fail2)) {
+    print "not ok 12 # Open should fail\n";
+} else {
+    print "ok 12\n";
+}
+if (!defined $warn) {
+    print "not ok 13 # warning is undef\n";
+} elsif ($warn =~ /^Cannot find encoding "latin42" at.*line \d+\.$/) {
+    print "ok 13\n";
+} else {
+    print "not ok 13 # warning is: \n";
+    $warn =~ s/^/# /mg;
+    print "$warn";
+}
 
 # Create a string of chars that are 3 bytes in UTF-8 
 my $str = "\x{1f80}" x 2048;
@@ -104,7 +147,8 @@ close(F);
 open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!";
 my $dstr = <F>;
 close(F);
-is($dstr, $str);
+print "not " unless ($dstr eq $str);
+print "ok 14\n";
 
 # Try decoding some bad stuff
 open(F,'>:raw',$threebyte) || die "Cannot open $threebyte:$!";
@@ -119,116 +163,11 @@ open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!";
 $dstr = join(":", <F>);
 close(F);
 if (ord('A') == 193) { # EBCDIC
-    is($dstr, "foo\\x8C\\x80\\x80\\x80bar\n:\\x80foo\n");
+    print "not " unless $dstr eq "foo\\x8C\\x80\\x80\\x80bar\n:\\x80foo\n";
 } else {
-    is($dstr, "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n");
+    print "not " unless $dstr eq "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n";
 }
-
-# Check that PerlIO::encoding can handle custom encodings that do funny
-# things with the buffer.
-use Encode::Encoding;
-package Extensive {
- @ISA = Encode::Encoding;
- __PACKAGE__->Define('extensive');
- sub encode($$;$) {
-  my ($self,$buf,$chk) = @_;
-  my $leftovers = '';
-  if ($buf =~ /(.*\n)(?!\z)/) {
-    $buf = $1;
-    $leftovers = $';
-  }
-  if ($chk) {
-   undef $_[1];
-   my @x = (' ') x 8000; # reuse the just-freed buffer
-   $_[1] = $leftovers;   # SvPVX now points elsewhere and is shorter
-  }                      # than bufsiz
-  $buf;
- }
- no warnings 'once'; 
- *decode = *encode;
-}
-open my $fh, ">:encoding(extensive)", \$buf;
-$fh->autoflush;
-print $fh "doughnut\n";
-print $fh "quaffee\n";
-# Print something longer than the buffer that encode() shrunk:
-print $fh "The beech leaves beech leaves on the beach by the beech.\n";
-close $fh;
-is $buf, "doughnut\nquaffee\nThe beech leaves beech leaves on the beach by"
-        ." the beech.\n", 'buffer realloc during encoding';
-$buf = "Sheila surely shod Sean\nin shoddy shoes.\n";
-open $fh, "<:encoding(extensive)", \$buf;
-is join("", <$fh>), "Sheila surely shod Sean\nin shoddy shoes.\n",
-   'buffer realloc during decoding';
-
-package Cower {
- @ISA = Encode::Encoding;
- __PACKAGE__->Define('cower');
- sub encode($$;$) {
-  my ($self,$buf,$chk) = @_;
-  my $leftovers = '';
-  if ($buf =~ /(.*\n)(?!\z)/) {
-    $buf = $1;
-    $leftovers = $';
-  }
-  if ($chk) {
-   no warnings; # stupid @_[1] warning
-   @_[1] = keys %{{$leftovers=>1}}; # shared hash key (copy-on-write)
-  }
-  $buf;
- }
- no warnings 'once'; 
- *decode = *encode;
-}
-open $fh, ">:encoding(cower)", \$buf;
-$fh->autoflush;
-print $fh $_ for qw "pumping plum pits";
-close $fh;
-is $buf, "pumpingplumpits", 'cowing buffer during encoding';
-$buf = "pumping\nplum\npits\n";
-open $fh, "<:encoding(cower)", \$buf;
-is join("", <$fh>), "pumping\nplum\npits\n",
-  'cowing buffer during decoding';
-
-package Globber {
- no warnings 'once';
- @ISA = Encode::Encoding;
- __PACKAGE__->Define('globber');
- sub encode($$;$) {
-  my ($self,$buf,$chk) = @_;
-  $_[1] = *foo if $chk;
-  $buf;
- }
- *decode = *encode;
-}
-
-# Here we just want to test there is no crash.  The actual output is not so
-# important.
-# We need a double eval, as scope unwinding will close the handle,
-# which croaks.
-# Under debugging builds with PERL_DESTRUCT_LEVEL set, we have to skip this
-# test, as it triggers bug #115692, resulting in string table warnings.
-require Config;
-SKIP: {
-skip "produces string table warnings", 2
-  if "@{[Config::non_bincompat_options()]}" =~ /\bDEBUGGING\b/
-   && $ENV{PERL_DESTRUCT_LEVEL};
-
-eval { eval {
-    open my $fh, ">:encoding(globber)", \$buf;
-    print $fh "Agathopous Goodfoot\n";
-    close $fh;
-}; $e = $@};
-like $@||$e, qr/Close with partial character/,
-     'no crash when assigning glob to buffer in encode';
-$buf = "To hymn him who heard her herd herd\n";
-open $fh, "<:encoding(globber)", \$buf;
-my $x = <$fh>;
-close $fh;
-is $x, "To hymn him who heard her herd herd\n",
-     'no crash when assigning glob to buffer in decode';
-
-} # SKIP
+print "ok 15\n";
 
 END {
     1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte);
diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t
index 3944f7dff01..58420811a65 100755
--- a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t
+++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t
@@ -1,6 +1,10 @@
 #!./perl
 
 BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+    require "../t/test.pl";
     skip_all("No perlio") unless (find PerlIO::Layer 'perlio');
     if (ord("A") == 193) {
 	print "1..0 # Skip: EBCDIC\n";
@@ -10,7 +14,7 @@ BEGIN {
 	print "1..0 # Skip: No Encode\n";
 	exit 0;
     }
-    use Test::More tests => 9;
+    plan (9);
     import Encode qw(:fallback_all);
 }
 
diff --git a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm
index 7e93f6da562..5188ddbc3c9 100644
--- a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm
+++ b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm
@@ -1,7 +1,7 @@
 package PerlIO::scalar;
-our $VERSION = '0.18_01';
-require XSLoader;
-XSLoader::load();
+our $VERSION = '0.07';
+use XSLoader ();
+XSLoader::load 'PerlIO::scalar';
 1;
 __END__
 
diff --git a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs
index 5c5eccf812a..d9574d7be84 100644
--- a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs
+++ b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs
@@ -6,9 +6,6 @@
 
 #include "perliol.h"
 
-static const char code_point_warning[] =
- "Strings with code points over 0xFF may not be mapped into in-memory file handles\n";
-
 typedef struct {
     struct _PerlIO base;	/* Base "class" info */
     SV *var;
@@ -25,10 +22,9 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
      * using, otherwise arg (from binmode presumably) is either NULL
      * or the _name_ of the scalar
      */
-    if (arg && SvOK(arg)) {
+    if (arg) {
 	if (SvROK(arg)) {
-	    if (SvREADONLY(SvRV(arg)) && !SvIsCOW(SvRV(arg))
-	     && mode && *mode != 'r') {
+	    if (SvREADONLY(SvRV(arg)) && mode && *mode != 'r') {
 		if (ckWARN(WARN_LAYER))
 		    Perl_warner(aTHX_ packWARN(WARN_LAYER), "%s", PL_no_modify);
 		SETERRNO(EINVAL, SS_IVCHAN);
@@ -49,27 +45,13 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
 	s->var = newSVpvn("", 0);
     }
     SvUPGRADE(s->var, SVt_PV);
-
     code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
     if (!SvOK(s->var) || (PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
-    {
-	sv_force_normal(s->var);
 	SvCUR_set(s->var, 0);
-	if (SvPOK(s->var)) *SvPVX(s->var) = 0;
-    }
-    if (SvUTF8(s->var) && !sv_utf8_downgrade(s->var, TRUE)) {
-	if (ckWARN(WARN_UTF8))
-	    Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning);
-	SETERRNO(EINVAL, SS_IVCHAN);
-	SvREFCNT_dec(s->var);
-	s->var = Nullsv;
-	return -1;
-    }
     if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
-	s->posn = SvOK(s->var) ? sv_len(s->var) : 0;
+	s->posn = SvCUR(s->var);
     else
 	s->posn = 0;
-    SvSETMAGIC(s->var);
     return code;
 }
 
@@ -95,7 +77,6 @@ PerlIOScalar_close(pTHX_ PerlIO * f)
 IV
 PerlIOScalar_fileno(pTHX_ PerlIO * f)
 {
-    PERL_UNUSED_ARG(f);
     return -1;
 }
 
@@ -103,33 +84,36 @@ IV
 PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-    Off_t new_posn;
-
+    STRLEN oldcur = SvCUR(s->var);
+    STRLEN newlen;
     switch (whence) {
     case SEEK_SET:
-	new_posn = offset;
+	s->posn = offset;
 	break;
     case SEEK_CUR:
-	new_posn = offset + s->posn;
+	s->posn = offset + s->posn;
 	break;
     case SEEK_END:
-      {
-	STRLEN oldcur;
-	(void)SvPV(s->var, oldcur);
-	new_posn = offset + oldcur;
+	s->posn = offset + SvCUR(s->var);
 	break;
-      }
-    default:
-        SETERRNO(EINVAL, SS_IVCHAN);
-        return -1;
     }
-    if (new_posn < 0) {
+    if (s->posn < 0) {
         if (ckWARN(WARN_LAYER))
 	    Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
 	SETERRNO(EINVAL, SS_IVCHAN);
 	return -1;
     }
-    s->posn = new_posn;
+    newlen = (STRLEN) s->posn;
+    if (newlen > oldcur) {
+	(void) SvGROW(s->var, newlen);
+	Zero(SvPVX(s->var) + oldcur, newlen - oldcur, char);
+	/* No SvCUR_set(), though.  This is just a seek, not a write. */
+    }
+    else if (!SvPVX(s->var)) {
+	/* ensure there's always a character buffer */
+	(void)SvGROW(s->var,1);
+    }
+    SvPOK_on(s->var);
     return 0;
 }
 
@@ -140,52 +124,6 @@ PerlIOScalar_tell(pTHX_ PerlIO * f)
     return s->posn;
 }
 
-
-SSize_t
-PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
-{
-    if (!f)
-	return 0;
-    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
-	PerlIOBase(f)->flags |= PERLIO_F_ERROR;
-	SETERRNO(EBADF, SS_IVCHAN);
-	return 0;
-    }
-    {
-	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-	SV *sv = s->var;
-	char *p;
-	STRLEN len;
-        STRLEN got;
-	p = SvPV(sv, len);
-	if (SvUTF8(sv)) {
-	    if (sv_utf8_downgrade(sv, TRUE)) {
-	        p = SvPV_nomg(sv, len);
-	    }
-	    else {
-	        if (ckWARN(WARN_UTF8))
-		    Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning);
-	        SETERRNO(EINVAL, SS_IVCHAN);
-	        return -1;
-	    }
-	}
-        /* I assume that Off_t is at least as large as len (which 
-         * seems safe) and that the size of the buffer in our SV is
-         * always less than half the size of the address space
-         */
-        assert(sizeof(Off_t) >= sizeof(len));
-        assert((Off_t)len >= 0);
-        if ((Off_t)len <= s->posn)
-	    return 0;
-	got = len - (STRLEN)(s->posn);
-	if ((STRLEN)got > (STRLEN)count)
-	    got = (STRLEN)count;
-	Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR);
-	s->posn += (Off_t)got;
-	return (SSize_t)got;
-    }
-}
-
 SSize_t
 PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 {
@@ -194,40 +132,23 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
 	SV *sv = s->var;
 	char *dst;
-	SvGETMAGIC(sv);
-	if (!SvROK(sv)) sv_force_normal(sv);
-	if (SvOK(sv)) SvPV_force_nomg_nolen(sv);
-	if (SvUTF8(sv) && !sv_utf8_downgrade(sv, TRUE)) {
-	    if (ckWARN(WARN_UTF8))
-	        Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning);
-	    SETERRNO(EINVAL, SS_IVCHAN);
-	    return 0;
-	}
 	if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
-	    dst = SvGROW(sv, SvCUR(sv) + count + 1);
+	    dst = SvGROW(sv, SvCUR(sv) + count);
 	    offset = SvCUR(sv);
 	    s->posn = offset + count;
 	}
 	else {
-	    STRLEN const cur = SvCUR(sv);
-	    if ((STRLEN)s->posn > cur) {
-		dst = SvGROW(sv, (STRLEN)s->posn + count + 1);
-		Zero(SvPVX(sv) + cur, (STRLEN)s->posn - cur, char);
-	    }
-	    else if ((s->posn + count) >= cur)
-		dst = SvGROW(sv, (STRLEN)s->posn + count + 1);
+	    if ((s->posn + count) > SvCUR(sv))
+		dst = SvGROW(sv, (STRLEN)s->posn + count);
 	    else
-		dst = SvPVX(sv);
+		dst = SvPV_nolen(sv);
 	    offset = s->posn;
 	    s->posn += count;
 	}
 	Move(vbuf, dst + offset, count, char);
-	if ((STRLEN) s->posn > SvCUR(sv)) {
+	if ((STRLEN) s->posn > SvCUR(sv))
 	    SvCUR_set(sv, (STRLEN)s->posn);
-	    dst[(STRLEN) s->posn] = 0;
-	}
-	SvPOK_on(sv);
-	SvSETMAGIC(sv);
+	SvPOK_on(s->var);
 	return count;
     }
     else
@@ -237,14 +158,12 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 IV
 PerlIOScalar_fill(pTHX_ PerlIO * f)
 {
-    PERL_UNUSED_ARG(f);
     return -1;
 }
 
 IV
 PerlIOScalar_flush(pTHX_ PerlIO * f)
 {
-    PERL_UNUSED_ARG(f);
     return 0;
 }
 
@@ -253,7 +172,6 @@ PerlIOScalar_get_base(pTHX_ PerlIO * f)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
     if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
-	SvGETMAGIC(s->var);
 	return (STDCHAR *) SvPV_nolen(s->var);
     }
     return (STDCHAR *) NULL;
@@ -274,10 +192,8 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
 	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-	STRLEN len;
-	(void)SvPV(s->var,len);
-	if ((Off_t)len > s->posn)
-	    return len - (STRLEN)s->posn;
+	if (SvCUR(s->var) > (STRLEN) s->posn)
+	    return SvCUR(s->var) - (STRLEN)s->posn;
 	else
 	    return 0;
     }
@@ -289,7 +205,6 @@ PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
 	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-	SvGETMAGIC(s->var);
 	return SvCUR(s->var);
     }
     return 0;
@@ -299,10 +214,7 @@ void
 PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-    STRLEN len;
-    PERL_UNUSED_ARG(ptr);
-    (void)SvPV(s->var,len);
-    s->posn = len - cnt;
+    s->posn = SvCUR(s->var) - cnt;
 }
 
 PerlIO *
@@ -311,9 +223,6 @@ PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
 		  PerlIO * f, int narg, SV ** args)
 {
     SV *arg = (narg > 0) ? *args : PerlIOArg;
-    PERL_UNUSED_ARG(fd);
-    PERL_UNUSED_ARG(imode);
-    PERL_UNUSED_ARG(perm);
     if (SvROK(arg) || SvPOK(arg)) {
 	if (!f) {
 	    f = PerlIO_allocate(aTHX);
@@ -347,24 +256,10 @@ PerlIO *
 PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
 		 int flags)
 {
-    /* Duplication causes the scalar layer to be pushed on to clone, caus-
-       ing the cloned scalar to be set to the empty string by
-       PerlIOScalar_pushed.  So set aside our scalar temporarily. */
-    PerlIOScalar * const os = PerlIOSelf(o, PerlIOScalar);
-    PerlIOScalar *fs = NULL; /* avoid "may be used uninitialized" warning */
-    SV * const var = os->var;
-    os->var = newSVpvs("");
     if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
-	fs = PerlIOSelf(f, PerlIOScalar);
-	/* var has been set by implicit push, so replace it */
-	SvREFCNT_dec(fs->var);
-    }
-    SvREFCNT_dec(os->var);
-    os->var = var;
-    if (f) {
-	SV * const rv = PerlIOScalar_arg(aTHX_ o, param, flags);
-	fs->var = SvREFCNT_inc(SvRV(rv));
-	SvREFCNT_dec(rv);
+	PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar);
+	PerlIOScalar *os = PerlIOSelf(o, PerlIOScalar);
+	/* var has been set by implicit push */
 	fs->posn = os->posn;
     }
     return f;
@@ -382,7 +277,7 @@ PERLIO_FUNCS_DECL(PerlIO_scalar) = {
     PerlIOScalar_arg,
     PerlIOScalar_fileno,
     PerlIOScalar_dup,
-    PerlIOScalar_read,
+    PerlIOBase_read,
     NULL, /* unread */
     PerlIOScalar_write,
     PerlIOScalar_seek,
diff --git a/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t b/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t
index f4cfbefaf96..393ce0d375f 100755
--- a/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t
+++ b/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t
@@ -1,6 +1,8 @@
 #!./perl
 
 BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
     unless (find PerlIO::Layer 'perlio') {
 	print "1..0 # Skip: not perlio\n";
 	exit 0;
@@ -16,7 +18,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere.
 
 $| = 1;
 
-use Test::More tests => 120;
+use Test::More tests => 55;
 
 my $fh;
 my $var = "aaa\n";
@@ -97,7 +99,7 @@ open $fh, '<', \42;
 is(<$fh>, "42", "reading from non-string scalars");
 close $fh;
 
-{ package P; sub TIESCALAR {bless{}} sub FETCH { "shazam" } sub STORE {} }
+{ package P; sub TIESCALAR {bless{}} sub FETCH { "shazam" } }
 tie $p, P; open $fh, '<', \$p;
 is(<$fh>, "shazam", "reading from magic scalars");
 
@@ -109,11 +111,6 @@ is(<$fh>, "shazam", "reading from magic scalars");
     print $fh "foo";
     close $fh;
     is($warn, 0, "no warnings when writing to an undefined scalar");
-    undef $scalar;
-    open $fh, '>>', \$scalar;
-    print $fh "oof";
-    close $fh;
-    is($warn, 0, "no warnings when appending to an undefined scalar");
 }
 
 {
@@ -137,7 +134,6 @@ is(<$fh>, "shazam", "reading from magic scalars");
         package MgUndef;
         sub TIESCALAR { bless [] }
         sub FETCH { $fetch++; return undef }
-	sub STORE {}
     }
     tie my $scalar, MgUndef;
 
@@ -235,278 +231,3 @@ EOF
     ok(!seek(F, -150, SEEK_END), $!);
 }
 
-# RT #43789: should respect tied scalar
-
-{
-    package TS;
-    my $s;
-    sub TIESCALAR { bless \my $x }
-    sub FETCH { $s .= ':F'; ${$_[0]} }
-    sub STORE { $s .= ":S($_[1])"; ${$_[0]} = $_[1] }
-
-    package main;
-
-    my $x;
-    $s = '';
-    tie $x, 'TS';
-    my $fh;
-
-    ok(open($fh, '>', \$x), 'open-write tied scalar');
-    $s .= ':O';
-    print($fh 'ABC');
-    $s .= ':P';
-    ok(seek($fh, 0, SEEK_SET));
-    $s .= ':SK';
-    print($fh 'DEF');
-    $s .= ':P';
-    ok(close($fh), 'close tied scalar - write');
-    is($s, ':F:S():O:F:S(ABC):P:SK:F:S(DEF):P', 'tied actions - write');
-    is($x, 'DEF', 'new value preserved');
-
-    $x = 'GHI';
-    $s = '';
-    ok(open($fh, '+<', \$x), 'open-read tied scalar');
-    $s .= ':O';
-    my $buf;
-    is(read($fh,$buf,2), 2, 'read1');
-    $s .= ':R';
-    is($buf, 'GH', 'buf1');
-    is(read($fh,$buf,2), 1, 'read2');
-    $s .= ':R';
-    is($buf, 'I', 'buf2');
-    is(read($fh,$buf,2), 0, 'read3');
-    $s .= ':R';
-    is($buf, '', 'buf3');
-    ok(close($fh), 'close tied scalar - read');
-    is($s, ':F:S(GHI):O:F:R:F:R:F:R', 'tied actions - read');
-}
-
-# [perl #78716] Seeking beyond the end of the string, then reading
-{
-    my $str = '1234567890';
-    open my $strIn, '<', \$str;
-    seek $strIn, 15, 1;
-    is read($strIn, my $buffer, 5), 0,
-     'seek beyond end end of string followed by read';
-}
-
-# Writing to COW scalars and non-PVs
-{
-    my $bovid = __PACKAGE__;
-    open my $handel, ">", \$bovid;
-    print $handel "the COW with the crumpled horn";
-    is $bovid, "the COW with the crumpled horn", 'writing to COW scalars';
-
-    package lrcg { use overload fallback => 1, '""'=>sub { 'chin' } }
-    seek $handel, 3, 0;
-    $bovid = bless [], lrcg::;
-    print $handel 'mney';
-    is $bovid, 'chimney', 'writing to refs';
-
-    seek $handel, 1, 0;
-    $bovid = 42;  # still has a PV
-    print $handel 5;
-    is $bovid, 45, 'writing to numeric scalar';
-
-    seek $handel, 1, 0;
-    undef $bovid;
-    $bovid = 42;   # just IOK
-    print $handel 5;
-    is $bovid, 45, 'writing to numeric scalar';
-}
-
-# [perl #92706]
-{
-    open my $fh, "<", \(my $f=*f); seek $fh, 2,1;
-    pass 'seeking on a glob copy';
-    open my $fh, "<", \(my $f=*f); seek $fh, -2,2;
-    pass 'seeking on a glob copy from the end';
-}
-
-# [perl #108398]
-sub has_trailing_nul(\$) {
-    my ($ref) = @_;
-    my $sv = B::svref_2object($ref);
-    return undef if !$sv->isa('B::PV');
-
-    my $cur = $sv->CUR;
-    my $len = $sv->LEN;
-    return 0 if $cur >= $len;
-
-    my $ptrlen = length(pack('P', ''));
-    my $ptrfmt
-	= $ptrlen == length(pack('J', 0)) ? 'J'
-	: $ptrlen == length(pack('I', 0)) ? 'I'
-	: die "Can't determine pointer format";
-
-    my $pv_addr = unpack $ptrfmt, pack 'P', $$ref;
-    my $trailing = unpack 'P', pack $ptrfmt, $pv_addr+$cur;
-    return $trailing eq "\0";
-}
-SKIP: {
-    if ($Config::Config{'extensions'} !~ m!\bPerlIO/scalar\b!) {
-	skip "no B", 4;
-    }
-    require B;
-
-    open my $fh, ">", \my $memfile or die $!;
-
-    print $fh "abc";
-    ok has_trailing_nul $memfile,
-	 'write appends trailing null when growing string';
-
-    seek $fh, 0,SEEK_SET;
-    print $fh "abc";
-    ok has_trailing_nul $memfile,
-	 'write appends trailing null when not growing string';
-
-    seek $fh, 200, SEEK_SET;
-    print $fh "abc";
-    ok has_trailing_nul $memfile,
-	 'write appends null when growing string after seek past end';
-
-    open $fh, ">", \($memfile = "hello");
-    ok has_trailing_nul $memfile,
-	 'initial truncation in ">" mode provides trailing null';
-}
-
-# [perl #112780] Cloning of in-memory handles
-SKIP: {
-  skip "no threads", 2 if !$Config::Config{useithreads};
-  require threads;
-  my $str = '';
-  open my $fh, ">", \$str;
-  $str = 'a';
-  is scalar threads::async(sub { my $foo = $str; $foo })->join, "a",
-    'scalars behind in-memory handles are cloned properly';
-  print $fh "a";
-  is scalar threads::async(sub { print $fh "b"; $str })->join, "ab",
-    'printing to a cloned in-memory handle works';
-}
-
-# [perl #113764] Duping via >&= (broken by the fix for #112870)
-{
-  open FILE, '>', \my $content or die "Couldn't open scalar filehandle";
-  open my $fh, ">&=FILE" or die "Couldn't open: $!";
-  print $fh "Foo-Bar\n";
-  close $fh;
-  close FILE;
-  is $content, "Foo-Bar\n", 'duping via >&=';
-}
-
-# [perl #109828] PerlIO::scalar does not handle UTF-8
-my $byte_warning = "Strings with code points over 0xFF may not be mapped into in-memory file handles\n";
-{
-    use Errno qw(EINVAL);
-    my @warnings;
-    local $SIG{__WARN__} = sub { push @warnings, "@_" };
-    my $content = "12\x{101}";
-    $! = 0;
-    ok(!open(my $fh, "<", \$content), "non-byte open should fail");
-    is(0+$!, EINVAL, "check \$! is updated");
-    is_deeply(\@warnings, [], "should be no warnings (yet)");
-    use warnings "utf8";
-    $! = 0;
-    ok(!open(my $fh, "<", \$content), "non byte open should fail (and warn)");
-    is(0+$!, EINVAL, "check \$! is updated even when we warn");
-    is_deeply(\@warnings, [ $byte_warning ], "should have warned");
-
-    @warnings = ();
-    $content = "12\xA1";
-    utf8::upgrade($content);
-    ok(open(my $fh, "<", \$content), "open upgraded scalar");
-    binmode $fh;
-    my $tmp;
-    is(read($fh, $tmp, 4), 3, "read should get the downgraded bytes");
-    is($tmp, "12\xA1", "check we got the expected bytes");
-    close $fh;
-    is_deeply(\@warnings, [], "should be no more warnings");
-}
-{ # changes after open
-    my $content = "abc";
-    ok(open(my $fh, "+<", \$content), "open a scalar");
-    binmode $fh;
-    my $tmp;
-    is(read($fh, $tmp, 1), 1, "basic read");
-    seek($fh, 1, SEEK_SET);
-    $content = "\xA1\xA2\xA3";
-    utf8::upgrade($content);
-    is(read($fh, $tmp, 1), 1, "read from post-open upgraded scalar");
-    is($tmp, "\xA2", "check we read the correct value");
-    seek($fh, 1, SEEK_SET);
-    $content = "\x{101}\x{102}\x{103}";
-
-    my @warnings;
-    local $SIG{__WARN__} = sub { push @warnings, "@_" };
-
-    $! = 0;
-    is(read($fh, $tmp, 1), undef, "read from scalar with >0xff chars");
-    is(0+$!, EINVAL, "check errno set correctly");
-    is_deeply(\@warnings, [], "should be no warning (yet)");
-    use warnings "utf8";
-    seek($fh, 1, SEEK_SET);
-    is(read($fh, $tmp, 1), undef, "read from scalar with >0xff chars");
-    is_deeply(\@warnings, [ $byte_warning ], "check warning");
-
-    select $fh; # make sure print fails rather tha buffers
-    $| = 1;
-    select STDERR;
-    no warnings "utf8";
-    @warnings = ();
-    $content = "\xA1\xA2\xA3";
-    utf8::upgrade($content);
-    seek($fh, 1, SEEK_SET);
-    ok((print $fh "A"), "print to an upgraded byte string");
-    seek($fh, 1, SEEK_SET);
-    is($content, "\xA1A\xA3", "check result");
-
-    $content = "\x{101}\x{102}\x{103}";
-    $! = 0;
-    ok(!(print $fh "B"), "write to an non-downgradable SV");
-    is(0+$!, EINVAL, "check errno set");
-
-    is_deeply(\@warnings, [], "should be no warning");
-
-    use warnings "utf8";
-    ok(!(print $fh "B"), "write to an non-downgradable SV (and warn)");
-    is_deeply(\@warnings, [ $byte_warning ], "check warning");
-}
-
-#  RT #119529: Reading refs should not loop
-
-{
-    my $x = \42;
-    open my $fh, "<", \$x;
-    my $got = <$fh>; # this used to loop
-    like($got, qr/^SCALAR\(0x[0-9a-f]+\)$/, "ref to a ref");
-    is ref $x, "SCALAR", "target scalar is still a reference";
-}
-
-# Appending to refs
-{
-    my $x = \42;
-    my $as_string = "$x";
-    open my $refh, ">>", \$x;
-    is ref $x, "SCALAR", 'still a ref after opening for appending';
-    print $refh "boo\n";
-    is $x, $as_string."boo\n", 'string gets appended to ref';
-}
-
-SKIP:
-{ # [perl #123443]
-    skip "Can't seek over 4GB with a small off_t", 4
-      if $Config::Config{lseeksize} < 8;
-    my $buf0 = "hello";
-    open my $fh, "<", \$buf0 or die $!;
-    ok(seek($fh, 2**32, SEEK_SET), "seek to a large position");
-    is(read($fh, my $tmp, 1), 0, "read from a large offset");
-    is($tmp, "", "should have read nothing");
-    ok(eof($fh), "fh should be eof");
-}
-
-{
-    my $buf0 = "hello";
-    open my $fh, "<", \$buf0 or die $!;
-    ok(!seek($fh, -10, SEEK_CUR), "seek to negative position");
-    is(tell($fh), 0, "shouldn't change the position");
-}
diff --git a/gnu/usr.bin/perl/ext/PerlIO-via/via.pm b/gnu/usr.bin/perl/ext/PerlIO-via/via.pm
index a10f7ee67e8..66aa974043e 100644
--- a/gnu/usr.bin/perl/ext/PerlIO-via/via.pm
+++ b/gnu/usr.bin/perl/ext/PerlIO-via/via.pm
@@ -1,7 +1,7 @@
 package PerlIO::via;
-our $VERSION = '0.15';
-require XSLoader;
-XSLoader::load();
+our $VERSION = '0.07';
+use XSLoader ();
+XSLoader::load 'PerlIO::via';
 1;
 __END__
 
@@ -74,7 +74,7 @@ C<FDOPEN> or by letting a lower layer do the open.
 
 Optional - called when the layer is about to be removed.
 
-=item $obj->UTF8($belowFlag,[$fh])
+=item $obj->UTF8($bellowFlag,[$fh])
 
 Optional - if present it will be called immediately after PUSHED has
 returned. It should return a true value if the layer expects data to be
@@ -84,7 +84,7 @@ UTF-8 encoded. If it returns true, the result is as if the caller had done
 
 If not present or if it returns false, then the stream is left with
 the UTF-8 flag clear.
-The I<$belowFlag> argument will be true if there is a layer below
+The I<$bellowFlag> argument will be true if there is a layer below
 and that layer was expecting UTF-8.
 
 =item $obj->OPEN($path,$mode,[$fh])
diff --git a/gnu/usr.bin/perl/ext/PerlIO-via/via.xs b/gnu/usr.bin/perl/ext/PerlIO-via/via.xs
index d7a037b054e..e50052ca51d 100644
--- a/gnu/usr.bin/perl/ext/PerlIO-via/via.xs
+++ b/gnu/usr.bin/perl/ext/PerlIO-via/via.xs
@@ -68,38 +68,32 @@ PerlIOVia_method(pTHX_ PerlIO * f, const char *method, CV ** save, int flags,
 		 ...)
 {
     PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
-    SV *result = Nullsv;
     CV *cv =
 	(*save) ? *save : PerlIOVia_fetchmethod(aTHX_ s, method, save);
+    SV *result = Nullsv;
+    va_list ap;
+    va_start(ap, flags);
     if (cv != (CV *) - 1) {
 	IV count;
 	dSP;
 	SV *arg;
-        va_list ap;
-
-        va_start(ap, flags);
 	PUSHSTACKi(PERLSI_MAGIC);
 	ENTER;
+	SPAGAIN;
 	PUSHMARK(sp);
 	XPUSHs(s->obj);
 	while ((arg = va_arg(ap, SV *))) {
 	    XPUSHs(arg);
 	}
-        va_end(ap);
 	if (*PerlIONext(f)) {
 	    if (!s->fh) {
-		GV *gv;
-		char *package = HvNAME_get(s->stash);
-
-                if (!package)
-                    return Nullsv; /* can this ever happen? */
-		gv = newGVgen(package);
+		GV *gv = newGVgen(HvNAME_get(s->stash));
 		GvIOp(gv) = newIO();
 		s->fh = newRV((SV *) gv);
 		s->io = GvIOp(gv);
 		if (gv) {
 		    /* shamelessly stolen from IO::File's new_tmpfile() */
-		    (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
+		    hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
 		}
 	    }
 	    IoIFP(s->io) = PerlIONext(f);
@@ -123,6 +117,7 @@ PerlIOVia_method(pTHX_ PerlIO * f, const char *method, CV ** save, int flags,
 	LEAVE;
 	POPSTACK;
     }
+    va_end(ap);
     return result;
 }
 
@@ -143,14 +138,14 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
 	else {
 	    STRLEN pkglen = 0;
 	    const char *pkg = SvPV(arg, pkglen);
-	    s->obj =
-		newSVpvn(Perl_form(aTHX_ "PerlIO::via::%s", pkg),
-			 pkglen + 13);
-	    s->stash = gv_stashpvn(SvPVX_const(s->obj), pkglen + 13, 0);
+	    s->obj = SvREFCNT_inc(arg);
+	    s->stash = gv_stashpvn(pkg, pkglen, 0);
 	    if (!s->stash) {
 		SvREFCNT_dec(s->obj);
-		s->obj = SvREFCNT_inc(arg);
-		s->stash = gv_stashpvn(pkg, pkglen, 0);
+		s->obj =
+		    newSVpvn(Perl_form(aTHX_ "PerlIO::via::%s", pkg),
+			     pkglen + 13);
+		s->stash = gv_stashpvn(SvPVX_const(s->obj), pkglen + 13, 0);
 	    }
 	    if (s->stash) {
 		char lmode[8];
@@ -160,7 +155,7 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
 		    /* binmode() passes NULL - so find out what mode is */
 		    mode = PerlIO_modestr(f,lmode);
 		}
-		modesv = newSVpvn_flags(mode, strlen(mode), SVs_TEMP);
+		modesv = sv_2mortal(newSVpvn(mode, strlen(mode)));
 		result = PerlIOVia_method(aTHX_ f, MYMethod(PUSHED), G_SCALAR,
 				     modesv, Nullsv);
 		if (result) {
@@ -400,7 +395,7 @@ SSize_t
 PerlIOVia_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 {
     PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
-    SV *buf = newSVpvn_flags((char *) vbuf, count, SVs_TEMP);
+    SV *buf = sv_2mortal(newSVpvn((char *) vbuf, count));
     SV *result =
 	PerlIOVia_method(aTHX_ f, MYMethod(UNREAD), G_SCALAR, buf, Nullsv);
     if (result)
@@ -541,7 +536,6 @@ void
 PerlIOVia_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
-    PERL_UNUSED_ARG(ptr);
     s->cnt = cnt;
 }
 
@@ -583,8 +577,6 @@ SV *
 PerlIOVia_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
 {
     PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
-    PERL_UNUSED_ARG(param);
-    PERL_UNUSED_ARG(flags);
     return PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
 }
 
diff --git a/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.pm b/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.pm
index 1d2e47210a7..415f9517fa4 100644
--- a/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.pm
+++ b/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.pm
@@ -5,8 +5,9 @@ use strict;
 use Carp;
 
 require Exporter;
+require AutoLoader;
 
-our @ISA     = qw/ Exporter /;
+our @ISA     = qw/ Exporter AutoLoader /;
 our @EXPORT  = qw/ hostname /;
 
 our $VERSION;
@@ -14,12 +15,12 @@ our $VERSION;
 our $host;
 
 BEGIN {
-    $VERSION = '1.18';
+    $VERSION = '1.11';
     {
 	local $SIG{__DIE__};
 	eval {
 	    require XSLoader;
-	    XSLoader::load();
+	    XSLoader::load('Sys::Hostname', $VERSION);
 	};
 	warn $@ if $@;
     }
@@ -64,6 +65,10 @@ sub hostname {
     chomp($host = `hostname 2> NUL`) unless defined $host;
     return $host;
   }
+  elsif ($^O eq 'epoc') {
+    $host = 'localhost';
+    return $host;
+  }
   else {  # Unix
     # is anyone going to make it here?
 
@@ -92,7 +97,7 @@ sub hostname {
     || eval {
 	local $SIG{__DIE__};
 	local $SIG{CHLD};
-	$host = `(hostname) 2>/dev/null`; # BSDish
+	$host = `(hostname) 2>/dev/null`; # bsdish
     }
 
     # method 4 - use POSIX::uname(), which strictly can't be expected to be
@@ -109,6 +114,13 @@ sub hostname {
 	$host = `uname -n 2>/dev/null`; ## sysVish
     }
 
+    # method 6 - Apollo pre-SR10
+    || eval {
+	local $SIG{__DIE__};
+        my($a,$b,$c,$d);
+	($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
+    }
+
     # bummer
     || croak "Cannot get host name of local machine";  
 
diff --git a/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.xs b/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.xs
index 6e974dd41fe..23ecd694ed6 100644
--- a/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.xs
+++ b/gnu/usr.bin/perl/ext/Sys-Hostname/Hostname.xs
@@ -1,5 +1,3 @@
-#define PERL_NO_GET_CONTEXT
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -37,7 +35,7 @@ ghname()
     {
 	char tmps[MAXHOSTNAMELEN];
 	retval = PerlSock_gethostname(tmps, sizeof(tmps));
-	sv = newSVpv(tmps, 0);
+	sv = newSVpvn(tmps, strlen(tmps));
     }
 #else
 #  ifdef HAS_PHOSTNAME
@@ -55,8 +53,9 @@ ghname()
 	    *p++ = c;
 	}
 	PerlProc_pclose(io);
+	*p = '\0';
 	retval = 0;
-	sv = newSVpvn(tmps, p - tmps);
+	sv = newSVpvn(tmps, strlen(tmps));
     }
 #  else
 #    ifdef HAS_UNAME
@@ -64,7 +63,7 @@ ghname()
 	struct utsname u;
 	if (PerlEnv_uname(&u) == -1)
 	    goto check_out;
-	sv = newSVpv(u.nodename, 0);
+	sv = newSVpvn(u.nodename, strlen(u.nodename));
         retval = 0;
     }
 #    endif
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm b/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm
index 63ea85831a0..12d0a03e018 100644
--- a/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm
+++ b/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm
@@ -1,58 +1,32 @@
 package XS::APItest;
 
-{ use 5.011001; }
+use 5.008;
 use strict;
 use warnings;
 use Carp;
 
-our $VERSION = '0.60_01';
+use base qw/ DynaLoader Exporter /;
 
-require XSLoader;
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
 
 # Export everything since these functions are only used by a test script
-# Export subpackages too - in effect, export all their routines into us, then
-# export everything from us.
-sub import {
-    my $package = shift;
-    croak ("Can't export for '$package'") unless $package eq __PACKAGE__;
-    my $exports;
-    @{$exports}{@_} = () if @_;
-
-    my $callpkg = caller;
-
-    my @stashes = ('XS::APItest::', \%XS::APItest::);
-    while (my ($stash_name, $stash) = splice @stashes, 0, 2) {
-	while (my ($sym_name, $glob) = each %$stash) {
-	    if ($sym_name =~ /::$/) {
-		# Skip any subpackages that are clearly OO
-		next if *{$glob}{HASH}{'new'};
-		# and any that have AUTOLOAD
-		next if *{$glob}{HASH}{AUTOLOAD};
-		push @stashes, "$stash_name$sym_name", *{$glob}{HASH};
-	    } elsif (ref $glob eq 'SCALAR' || *{$glob}{CODE}) {
-		if ($exports) {
-		    next if !exists $exports->{$sym_name};
-		    delete $exports->{$sym_name};
-		}
-		no strict 'refs';
-		*{"$callpkg\::$sym_name"} = \&{"$stash_name$sym_name"};
-	    }
-	}
-    }
-    foreach (keys %{$exports||{}}) {
-	next unless /\A(?:rpn|calcrpn|stufftest|swaptwostmts|looprest|scopelessblock|stmtasexpr|stmtsasexpr|loopblock|blockasexpr|swaplabel|labelconst|arrayfullexpr|arraylistexpr|arraytermexpr|arrayarithexpr|arrayexprflags)\z/;
-	$^H{"XS::APItest/$_"} = 1;
-	delete $exports->{$_};
-    }
-    if ($exports) {
-	my @carp = keys %$exports;
-	if (@carp) {
-	    croak(join '',
-		  (map "\"$_\" is not exported by the $package module\n", sort @carp),
-		  "Can't continue after import errors");
-	}
-    }
-}
+our @EXPORT = qw( print_double print_int print_long
+		  print_float print_long_double have_long_double print_flush
+		  mpushp mpushn mpushi mpushu
+		  mxpushp mxpushn mxpushi mxpushu
+		  call_sv call_pv call_method eval_sv eval_pv require_pv
+		  G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
+		  G_KEEPERR G_NODEBUG G_METHOD G_WANT
+		  apitest_exception mycroak strtab
+		  my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv
+		  sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
+		  rmagical_cast rmagical_flags
+		  DPeek
+);
+
+our $VERSION = '0.15';
 
 use vars '$WARNINGS_ON_BOOTSTRAP';
 use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
@@ -89,16 +63,13 @@ END {
 }
 
 if ($WARNINGS_ON_BOOTSTRAP) {
-    XSLoader::load();
+    bootstrap XS::APItest $VERSION;
 } else {
     # More CHECK and INIT blocks that could warn:
     local $^W;
-    XSLoader::load();
+    bootstrap XS::APItest $VERSION;
 }
 
-# This XS function needs the lvalue attr applied.
-eval 'use attributes __PACKAGE__, \\&lv_temp_object, "lvalue"; 1' or die;
-
 1;
 __END__
 
@@ -111,14 +82,10 @@ XS::APItest - Test the perl C API
   use XS::APItest;
   print_double(4);
 
-  use XS::APItest qw(rpn calcrpn);
-  $triangle = rpn($n $n 1 + * 2 /);
-  calcrpn $triangle { $n $n 1 + * 2 / }
-
 =head1 ABSTRACT
 
-This module tests the perl C API. Also exposes various bit of the perl
-internals for the use of core test scripts.
+This module tests the perl C API. Currently tests that C<printf>
+works correctly.
 
 =head1 DESCRIPTION
 
@@ -214,22 +181,15 @@ correctly by C<printf>.
 
 Output is sent to STDOUT.
 
-=item B<filter>
-
-Installs a source filter that substitutes "e" for "o" (witheut regard fer
-what it might be medifying).
-
 =item B<call_sv>, B<call_pv>, B<call_method>
 
 These exercise the C calls of the same names. Everything after the flags
-arg is passed as the args to the called function. They return whatever
+arg is passed as the the args to the called function. They return whatever
 the C function itself pushed onto the stack, plus the return value from
 the function; for example
 
-    call_sv( sub { @_, 'c' }, G_ARRAY,  'a', 'b');
-    # returns 'a', 'b', 'c', 3
-    call_sv( sub { @_ },      G_SCALAR, 'a', 'b');
-    # returns 'b', 1
+    call_sv( sub { @_, 'c' }, G_ARRAY,  'a', 'b'); # returns 'a', 'b', 'c', 3
+    call_sv( sub { @_ },      G_SCALAR, 'a', 'b'); # returns 'b', 1
 
 =item B<eval_sv>
 
@@ -247,86 +207,6 @@ Exercises the C function of the same name. Returns nothing.
 
 =back
 
-=head1 KEYWORDS
-
-These are not supplied by default, but must be explicitly imported.
-They are lexically scoped.
-
-=over
-
-=item rpn(EXPRESSION)
-
-This construct is a Perl expression.  I<EXPRESSION> must be an RPN
-arithmetic expression, as described below.  The RPN expression is
-evaluated, and its value is returned as the value of the Perl expression.
-
-=item calcrpn VARIABLE { EXPRESSION }
-
-This construct is a complete Perl statement.  (No semicolon should
-follow the closing brace.)  I<VARIABLE> must be a Perl scalar C<my>
-variable, and I<EXPRESSION> must be an RPN arithmetic expression as
-described below.  The RPN expression is evaluated, and its value is
-assigned to the variable.
-
-=back
-
-=head2 RPN expression syntax
-
-Tokens of an RPN expression may be separated by whitespace, but such
-separation is usually not required.  It is required only where unseparated
-tokens would look like a longer token.  For example, C<12 34 +> can be
-written as C<12 34+>, but not as C<1234 +>.
-
-An RPN expression may be any of:
-
-=over
-
-=item C<1234>
-
-A sequence of digits is an unsigned decimal literal number.
-
-=item C<$foo>
-
-An alphanumeric name preceded by dollar sign refers to a Perl scalar
-variable.  Only variables declared with C<my> or C<state> are supported.
-If the variable's value is not a native integer, it will be converted
-to an integer, by Perl's usual mechanisms, at the time it is evaluated.
-
-=item I<A> I<B> C<+>
-
-Sum of I<A> and I<B>.
-
-=item I<A> I<B> C<->
-
-Difference of I<A> and I<B>, the result of subtracting I<B> from I<A>.
-
-=item I<A> I<B> C<*>
-
-Product of I<A> and I<B>.
-
-=item I<A> I<B> C</>
-
-Quotient when I<A> is divided by I<B>, rounded towards zero.
-Division by zero generates an exception.
-
-=item I<A> I<B> C<%>
-
-Remainder when I<A> is divided by I<B> with the quotient rounded towards zero.
-Division by zero generates an exception.
-
-=back
-
-Because the arithmetic operators all have fixed arity and are postfixed,
-there is no need for operator precedence, nor for a grouping operator
-to override precedence.  This is half of the point of RPN.
-
-An RPN expression can also be interpreted in another way, as a sequence
-of operations on a stack, one operation per token.  A literal or variable
-token pushes a value onto the stack.  A binary operator pulls two items
-off the stack, performs a calculation with them, and pushes the result
-back onto the stack.  The stack starts out empty, and at the end of the
-expression there must be exactly one value left on the stack.
-
 =head1 SEE ALSO
 
 L<XS::Typemap>, L<perlapi>.
@@ -335,16 +215,13 @@ L<XS::Typemap>, L<perlapi>.
 
 Tim Jenness, E<lt>t.jenness@jach.hawaii.eduE<gt>,
 Christian Soeller, E<lt>csoelle@mph.auckland.ac.nzE<gt>,
-Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt>,
-Andrew Main (Zefram) <zefram@fysh.org>
+Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
 Copyright (C) 2002,2004 Tim Jenness, Christian Soeller, Hugo van der Sanden.
 All Rights Reserved.
 
-Copyright (C) 2009 Andrew Main (Zefram) <zefram@fysh.org>
-
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs b/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs
index 8e78736af7a..7e7f78b2115 100644
--- a/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs
+++ b/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs
@@ -2,13 +2,7 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
-#include "fakesdio.h"   /* Causes us to use PerlIO below */
 
-typedef SV *SVREF;
-typedef PTR_TBL_t *XS__APItest__PtrTable;
-
-#define croak_fail() croak("fail at " __FILE__ " line %d", __LINE__)
-#define croak_fail_ne(h, w) croak("fail %p!=%p at " __FILE__ " line %d", (h), (w), __LINE__)
 
 /* for my_cxt tests */
 
@@ -17,22 +11,10 @@ typedef PTR_TBL_t *XS__APItest__PtrTable;
 typedef struct {
     int i;
     SV *sv;
-    GV *cscgv;
-    AV *cscav;
-    AV *bhkav;
-    bool bhk_record;
-    peep_t orig_peep;
-    peep_t orig_rpeep;
-    int peep_recording;
-    AV *peep_recorder;
-    AV *rpeep_recorder;
-    AV *xop_record;
 } my_cxt_t;
 
 START_MY_CXT
 
-MGVTBL vtbl_foo, vtbl_bar;
-
 /* indirect functions to test the [pa]MY_CXT macros */
 
 int
@@ -79,7 +61,7 @@ bool sv_setsv_cow_hashkey_notcore(void);
 /* A routine to test hv_delayfree_ent
    (which itself is tested by testing on hv_free_ent  */
 
-typedef void (freeent_function)(pTHX_ HV *, HE *);
+typedef void (freeent_function)(pTHX_ HV *, register HE *);
 
 void
 test_freeent(freeent_function *f) {
@@ -96,8 +78,8 @@ test_freeent(freeent_function *f) {
 #else
     /* Storing then deleting something should ensure that a hash entry is
        available.  */
-    (void) hv_store(test_hash, "", 0, &PL_sv_yes, 0);
-    (void) hv_delete(test_hash, "", 0, 0);
+    hv_store(test_hash, "", 0, &PL_sv_yes, 0);
+    hv_delete(test_hash, "", 0, 0);
 
     /* We need to "inline" new_he here as it's static, and the functions we
        test expect to be able to call del_HE on the HE  */
@@ -125,7 +107,7 @@ test_freeent(freeent_function *f) {
     i = 0;
     do {
 	mPUSHu(results[i]);
-    } while (++i < (int)(sizeof(results)/sizeof(results[0])));
+    } while (++i < sizeof(results)/sizeof(results[0]));
 
     /* Goodbye to our extra reference.  */
     SvREFCNT_dec(test_scalar);
@@ -136,7 +118,6 @@ static I32
 bitflip_key(pTHX_ IV action, SV *field) {
     MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
     SV *keysv;
-    PERL_UNUSED_ARG(action);
     if (mg && (keysv = mg->mg_obj)) {
 	STRLEN len;
 	const char *p = SvPV(keysv, len);
@@ -149,8 +130,8 @@ bitflip_key(pTHX_ IV action, SV *field) {
 		const char *const end = p + len;
 		while (p < end) {
 		    STRLEN len;
-		    UV chr = utf8_to_uvchr_buf((U8 *)p, (U8 *) end, &len);
-		    new_p = (char *)uvchr_to_utf8((U8 *)new_p, chr ^ 32);
+		    UV chr = utf8_to_uvuni((U8 *)p, &len);
+		    new_p = (char *)uvuni_to_utf8((U8 *)new_p, chr ^ 32);
 		    p += len;
 		}
 		SvUTF8_on(newkey);
@@ -172,7 +153,6 @@ static I32
 rot13_key(pTHX_ IV action, SV *field) {
     MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
     SV *keysv;
-    PERL_UNUSED_ARG(action);
     if (mg && (keysv = mg->mg_obj)) {
 	STRLEN len;
 	const char *p = SvPV(keysv, len);
@@ -255,1002 +235,17 @@ rot13_key(pTHX_ IV action, SV *field) {
 
 STATIC I32
 rmagical_a_dummy(pTHX_ IV idx, SV *sv) {
-    PERL_UNUSED_ARG(idx);
-    PERL_UNUSED_ARG(sv);
     return 0;
 }
 
 STATIC MGVTBL rmagical_b = { 0 };
 
-STATIC void
-blockhook_csc_start(pTHX_ int full)
-{
-    dMY_CXT;
-    AV *const cur = GvAV(MY_CXT.cscgv);
-
-    PERL_UNUSED_ARG(full);
-    SAVEGENERICSV(GvAV(MY_CXT.cscgv));
-
-    if (cur) {
-        I32 i;
-        AV *const new_av = newAV();
-
-        for (i = 0; i <= av_tindex(cur); i++) {
-            av_store(new_av, i, newSVsv(*av_fetch(cur, i, 0)));
-        }
-
-        GvAV(MY_CXT.cscgv) = new_av;
-    }
-}
-
-STATIC void
-blockhook_csc_pre_end(pTHX_ OP **o)
-{
-    dMY_CXT;
-
-    PERL_UNUSED_ARG(o);
-    /* if we hit the end of a scope we missed the start of, we need to
-     * unconditionally clear @CSC */
-    if (GvAV(MY_CXT.cscgv) == MY_CXT.cscav && MY_CXT.cscav) {
-        av_clear(MY_CXT.cscav);
-    }
-
-}
-
-STATIC void
-blockhook_test_start(pTHX_ int full)
-{
-    dMY_CXT;
-    AV *av;
-    
-    if (MY_CXT.bhk_record) {
-        av = newAV();
-        av_push(av, newSVpvs("start"));
-        av_push(av, newSViv(full));
-        av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
-    }
-}
-
-STATIC void
-blockhook_test_pre_end(pTHX_ OP **o)
-{
-    dMY_CXT;
-
-    PERL_UNUSED_ARG(o);
-    if (MY_CXT.bhk_record)
-        av_push(MY_CXT.bhkav, newSVpvs("pre_end"));
-}
-
-STATIC void
-blockhook_test_post_end(pTHX_ OP **o)
-{
-    dMY_CXT;
-
-    PERL_UNUSED_ARG(o);
-    if (MY_CXT.bhk_record)
-        av_push(MY_CXT.bhkav, newSVpvs("post_end"));
-}
-
-STATIC void
-blockhook_test_eval(pTHX_ OP *const o)
-{
-    dMY_CXT;
-    AV *av;
-
-    if (MY_CXT.bhk_record) {
-        av = newAV();
-        av_push(av, newSVpvs("eval"));
-        av_push(av, newSVpv(OP_NAME(o), 0));
-        av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
-    }
-}
-
-STATIC BHK bhk_csc, bhk_test;
-
-STATIC void
-my_peep (pTHX_ OP *o)
-{
-    dMY_CXT;
-
-    if (!o)
-	return;
-
-    MY_CXT.orig_peep(aTHX_ o);
-
-    if (!MY_CXT.peep_recording)
-	return;
-
-    for (; o; o = o->op_next) {
-	if (o->op_type == OP_CONST && cSVOPx_sv(o) && SvPOK(cSVOPx_sv(o))) {
-	    av_push(MY_CXT.peep_recorder, newSVsv(cSVOPx_sv(o)));
-	}
-    }
-}
-
-STATIC void
-my_rpeep (pTHX_ OP *o)
-{
-    dMY_CXT;
-
-    if (!o)
-	return;
-
-    MY_CXT.orig_rpeep(aTHX_ o);
-
-    if (!MY_CXT.peep_recording)
-	return;
-
-    for (; o; o = o->op_next) {
-	if (o->op_type == OP_CONST && cSVOPx_sv(o) && SvPOK(cSVOPx_sv(o))) {
-	    av_push(MY_CXT.rpeep_recorder, newSVsv(cSVOPx_sv(o)));
-	}
-    }
-}
-
-STATIC OP *
-THX_ck_entersub_args_lists(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
-{
-    PERL_UNUSED_ARG(namegv);
-    PERL_UNUSED_ARG(ckobj);
-    return ck_entersub_args_list(entersubop);
-}
-
-STATIC OP *
-THX_ck_entersub_args_scalars(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
-{
-    OP *aop = cUNOPx(entersubop)->op_first;
-    PERL_UNUSED_ARG(namegv);
-    PERL_UNUSED_ARG(ckobj);
-    if (!aop->op_sibling)
-	aop = cUNOPx(aop)->op_first;
-    for (aop = aop->op_sibling; aop->op_sibling; aop = aop->op_sibling) {
-	op_contextualize(aop, G_SCALAR);
-    }
-    return entersubop;
-}
-
-STATIC OP *
-THX_ck_entersub_multi_sum(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
-{
-    OP *sumop = NULL;
-    OP *pushop = cUNOPx(entersubop)->op_first;
-    PERL_UNUSED_ARG(namegv);
-    PERL_UNUSED_ARG(ckobj);
-    if (!pushop->op_sibling)
-	pushop = cUNOPx(pushop)->op_first;
-    while (1) {
-	OP *aop = pushop->op_sibling;
-	if (!aop->op_sibling)
-	    break;
-	pushop->op_sibling = aop->op_sibling;
-	aop->op_sibling = NULL;
-	op_contextualize(aop, G_SCALAR);
-	if (sumop) {
-	    sumop = newBINOP(OP_ADD, 0, sumop, aop);
-	} else {
-	    sumop = aop;
-	}
-    }
-    if (!sumop)
-	sumop = newSVOP(OP_CONST, 0, newSViv(0));
-    op_free(entersubop);
-    return sumop;
-}
-
-STATIC void test_op_list_describe_part(SV *res, OP *o);
-STATIC void
-test_op_list_describe_part(SV *res, OP *o)
-{
-    sv_catpv(res, PL_op_name[o->op_type]);
-    switch (o->op_type) {
-	case OP_CONST: {
-	    sv_catpvf(res, "(%d)", (int)SvIV(cSVOPx(o)->op_sv));
-	} break;
-    }
-    if (o->op_flags & OPf_KIDS) {
-	OP *k;
-	sv_catpvs(res, "[");
-	for (k = cUNOPx(o)->op_first; k; k = k->op_sibling)
-	    test_op_list_describe_part(res, k);
-	sv_catpvs(res, "]");
-    } else {
-	sv_catpvs(res, ".");
-    }
-}
-
-STATIC char *
-test_op_list_describe(OP *o)
-{
-    SV *res = sv_2mortal(newSVpvs(""));
-    if (o)
-	test_op_list_describe_part(res, o);
-    return SvPVX(res);
-}
-
-/* the real new*OP functions have a tendency to call fold_constants, and
- * other such unhelpful things, so we need our own versions for testing */
-
-#define mkUNOP(t, f) THX_mkUNOP(aTHX_ (t), (f))
-static OP *
-THX_mkUNOP(pTHX_ U32 type, OP *first)
-{
-    UNOP *unop;
-    NewOp(1103, unop, 1, UNOP);
-    unop->op_type   = (OPCODE)type;
-    unop->op_first  = first;
-    unop->op_flags  = OPf_KIDS;
-    return (OP *)unop;
-}
-
-#define mkBINOP(t, f, l) THX_mkBINOP(aTHX_ (t), (f), (l))
-static OP *
-THX_mkBINOP(pTHX_ U32 type, OP *first, OP *last)
-{
-    BINOP *binop;
-    NewOp(1103, binop, 1, BINOP);
-    binop->op_type      = (OPCODE)type;
-    binop->op_first     = first;
-    binop->op_flags     = OPf_KIDS;
-    binop->op_last      = last;
-    first->op_sibling   = last;
-    return (OP *)binop;
-}
-
-#define mkLISTOP(t, f, s, l) THX_mkLISTOP(aTHX_ (t), (f), (s), (l))
-static OP *
-THX_mkLISTOP(pTHX_ U32 type, OP *first, OP *sib, OP *last)
-{
-    LISTOP *listop;
-    NewOp(1103, listop, 1, LISTOP);
-    listop->op_type     = (OPCODE)type;
-    listop->op_flags    = OPf_KIDS;
-    listop->op_first    = first;
-    first->op_sibling   = sib;
-    sib->op_sibling     = last;
-    listop->op_last     = last;
-    return (OP *)listop;
-}
-
-static char *
-test_op_linklist_describe(OP *start)
-{
-    SV *rv = sv_2mortal(newSVpvs(""));
-    OP *o;
-    o = start = LINKLIST(start);
-    do {
-        sv_catpvs(rv, ".");
-        sv_catpv(rv, OP_NAME(o));
-        if (o->op_type == OP_CONST)
-            sv_catsv(rv, cSVOPo->op_sv);
-        o = o->op_next;
-    } while (o && o != start);
-    return SvPVX(rv);
-}
-
-/** establish_cleanup operator, ripped off from Scope::Cleanup **/
-
-STATIC void
-THX_run_cleanup(pTHX_ void *cleanup_code_ref)
-{
-    dSP;
-    PUSHSTACK;
-    ENTER;
-    SAVETMPS;
-    PUSHMARK(SP);
-    call_sv((SV*)cleanup_code_ref, G_VOID|G_DISCARD);
-    FREETMPS;
-    LEAVE;
-    POPSTACK;
-}
-
-STATIC OP *
-THX_pp_establish_cleanup(pTHX)
-{
-    dSP;
-    SV *cleanup_code_ref;
-    cleanup_code_ref = newSVsv(POPs);
-    SAVEFREESV(cleanup_code_ref);
-    SAVEDESTRUCTOR_X(THX_run_cleanup, cleanup_code_ref);
-    if(GIMME_V != G_VOID) PUSHs(&PL_sv_undef);
-    RETURN;
-}
-
-STATIC OP *
-THX_ck_entersub_establish_cleanup(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
-{
-    OP *pushop, *argop, *estop;
-    ck_entersub_args_proto(entersubop, namegv, ckobj);
-    pushop = cUNOPx(entersubop)->op_first;
-    if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
-    argop = pushop->op_sibling;
-    pushop->op_sibling = argop->op_sibling;
-    argop->op_sibling = NULL;
-    op_free(entersubop);
-    NewOpSz(0, estop, sizeof(UNOP));
-    estop->op_type = OP_RAND;
-    estop->op_ppaddr = THX_pp_establish_cleanup;
-    cUNOPx(estop)->op_flags = OPf_KIDS;
-    cUNOPx(estop)->op_first = argop;
-    PL_hints |= HINT_BLOCK_SCOPE;
-    return estop;
-}
-
-STATIC OP *
-THX_ck_entersub_postinc(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
-{
-    OP *pushop, *argop;
-    ck_entersub_args_proto(entersubop, namegv, ckobj);
-    pushop = cUNOPx(entersubop)->op_first;
-    if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
-    argop = pushop->op_sibling;
-    pushop->op_sibling = argop->op_sibling;
-    argop->op_sibling = NULL;
-    op_free(entersubop);
-    return newUNOP(OP_POSTINC, 0,
-	op_lvalue(op_contextualize(argop, G_SCALAR), OP_POSTINC));
-}
-
-STATIC OP *
-THX_ck_entersub_pad_scalar(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
-{
-    OP *pushop, *argop;
-    PADOFFSET padoff = NOT_IN_PAD;
-    SV *a0, *a1;
-    ck_entersub_args_proto(entersubop, namegv, ckobj);
-    pushop = cUNOPx(entersubop)->op_first;
-    if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
-    argop = pushop->op_sibling;
-    if(argop->op_type != OP_CONST || argop->op_sibling->op_type != OP_CONST)
-	croak("bad argument expression type for pad_scalar()");
-    a0 = cSVOPx_sv(argop);
-    a1 = cSVOPx_sv(argop->op_sibling);
-    switch(SvIV(a0)) {
-	case 1: {
-	    SV *namesv = sv_2mortal(newSVpvs("$"));
-	    sv_catsv(namesv, a1);
-	    padoff = pad_findmy_sv(namesv, 0);
-	} break;
-	case 2: {
-	    char *namepv;
-	    STRLEN namelen;
-	    SV *namesv = sv_2mortal(newSVpvs("$"));
-	    sv_catsv(namesv, a1);
-	    namepv = SvPV(namesv, namelen);
-	    padoff = pad_findmy_pvn(namepv, namelen, SvUTF8(namesv));
-	} break;
-	case 3: {
-	    char *namepv;
-	    SV *namesv = sv_2mortal(newSVpvs("$"));
-	    sv_catsv(namesv, a1);
-	    namepv = SvPV_nolen(namesv);
-	    padoff = pad_findmy_pv(namepv, SvUTF8(namesv));
-	} break;
-	case 4: {
-	    padoff = pad_findmy_pvs("$foo", 0);
-	} break;
-	default: croak("bad type value for pad_scalar()");
-    }
-    op_free(entersubop);
-    if(padoff == NOT_IN_PAD) {
-	return newSVOP(OP_CONST, 0, newSVpvs("NOT_IN_PAD"));
-    } else if(PAD_COMPNAME_FLAGS_isOUR(padoff)) {
-	return newSVOP(OP_CONST, 0, newSVpvs("NOT_MY"));
-    } else {
-	OP *padop = newOP(OP_PADSV, 0);
-	padop->op_targ = padoff;
-	return padop;
-    }
-}
-
-/** RPN keyword parser **/
-
-#define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV)
-#define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP)
-#define sv_is_string(sv) \
-    (!sv_is_glob(sv) && !sv_is_regexp(sv) && \
-     (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK)))
-
-static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv;
-static SV *hintkey_swaptwostmts_sv, *hintkey_looprest_sv;
-static SV *hintkey_scopelessblock_sv;
-static SV *hintkey_stmtasexpr_sv, *hintkey_stmtsasexpr_sv;
-static SV *hintkey_loopblock_sv, *hintkey_blockasexpr_sv;
-static SV *hintkey_swaplabel_sv, *hintkey_labelconst_sv;
-static SV *hintkey_arrayfullexpr_sv, *hintkey_arraylistexpr_sv;
-static SV *hintkey_arraytermexpr_sv, *hintkey_arrayarithexpr_sv;
-static SV *hintkey_arrayexprflags_sv;
-static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
-
-/* low-level parser helpers */
-
-#define PL_bufptr (PL_parser->bufptr)
-#define PL_bufend (PL_parser->bufend)
-
-/* RPN parser */
-
-#define parse_var() THX_parse_var(aTHX)
-static OP *THX_parse_var(pTHX)
-{
-    char *s = PL_bufptr;
-    char *start = s;
-    PADOFFSET varpos;
-    OP *padop;
-    if(*s != '$') croak("RPN syntax error");
-    while(1) {
-	char c = *++s;
-	if(!isALNUM(c)) break;
-    }
-    if(s-start < 2) croak("RPN syntax error");
-    lex_read_to(s);
-    varpos = pad_findmy_pvn(start, s-start, 0);
-    if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos))
-	croak("RPN only supports \"my\" variables");
-    padop = newOP(OP_PADSV, 0);
-    padop->op_targ = varpos;
-    return padop;
-}
-
-#define push_rpn_item(o) \
-    (tmpop = (o), tmpop->op_sibling = stack, stack = tmpop)
-#define pop_rpn_item() \
-    (!stack ? (croak("RPN stack underflow"), (OP*)NULL) : \
-     (tmpop = stack, stack = stack->op_sibling, \
-      tmpop->op_sibling = NULL, tmpop))
-
-#define parse_rpn_expr() THX_parse_rpn_expr(aTHX)
-static OP *THX_parse_rpn_expr(pTHX)
-{
-    OP *stack = NULL, *tmpop;
-    while(1) {
-	I32 c;
-	lex_read_space(0);
-	c = lex_peek_unichar(0);
-	switch(c) {
-	    case /*(*/')': case /*{*/'}': {
-		OP *result = pop_rpn_item();
-		if(stack) croak("RPN expression must return a single value");
-		return result;
-	    } break;
-	    case '0': case '1': case '2': case '3': case '4':
-	    case '5': case '6': case '7': case '8': case '9': {
-		UV val = 0;
-		do {
-		    lex_read_unichar(0);
-		    val = 10*val + (c - '0');
-		    c = lex_peek_unichar(0);
-		} while(c >= '0' && c <= '9');
-		push_rpn_item(newSVOP(OP_CONST, 0, newSVuv(val)));
-	    } break;
-	    case '$': {
-		push_rpn_item(parse_var());
-	    } break;
-	    case '+': {
-		OP *b = pop_rpn_item();
-		OP *a = pop_rpn_item();
-		lex_read_unichar(0);
-		push_rpn_item(newBINOP(OP_I_ADD, 0, a, b));
-	    } break;
-	    case '-': {
-		OP *b = pop_rpn_item();
-		OP *a = pop_rpn_item();
-		lex_read_unichar(0);
-		push_rpn_item(newBINOP(OP_I_SUBTRACT, 0, a, b));
-	    } break;
-	    case '*': {
-		OP *b = pop_rpn_item();
-		OP *a = pop_rpn_item();
-		lex_read_unichar(0);
-		push_rpn_item(newBINOP(OP_I_MULTIPLY, 0, a, b));
-	    } break;
-	    case '/': {
-		OP *b = pop_rpn_item();
-		OP *a = pop_rpn_item();
-		lex_read_unichar(0);
-		push_rpn_item(newBINOP(OP_I_DIVIDE, 0, a, b));
-	    } break;
-	    case '%': {
-		OP *b = pop_rpn_item();
-		OP *a = pop_rpn_item();
-		lex_read_unichar(0);
-		push_rpn_item(newBINOP(OP_I_MODULO, 0, a, b));
-	    } break;
-	    default: {
-		croak("RPN syntax error");
-	    } break;
-	}
-    }
-}
-
-#define parse_keyword_rpn() THX_parse_keyword_rpn(aTHX)
-static OP *THX_parse_keyword_rpn(pTHX)
-{
-    OP *op;
-    lex_read_space(0);
-    if(lex_peek_unichar(0) != '('/*)*/)
-	croak("RPN expression must be parenthesised");
-    lex_read_unichar(0);
-    op = parse_rpn_expr();
-    if(lex_peek_unichar(0) != /*(*/')')
-	croak("RPN expression must be parenthesised");
-    lex_read_unichar(0);
-    return op;
-}
-
-#define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX)
-static OP *THX_parse_keyword_calcrpn(pTHX)
-{
-    OP *varop, *exprop;
-    lex_read_space(0);
-    varop = parse_var();
-    lex_read_space(0);
-    if(lex_peek_unichar(0) != '{'/*}*/)
-	croak("RPN expression must be braced");
-    lex_read_unichar(0);
-    exprop = parse_rpn_expr();
-    if(lex_peek_unichar(0) != /*{*/'}')
-	croak("RPN expression must be braced");
-    lex_read_unichar(0);
-    return newASSIGNOP(OPf_STACKED, varop, 0, exprop);
-}
-
-#define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX)
-static OP *THX_parse_keyword_stufftest(pTHX)
-{
-    I32 c;
-    bool do_stuff;
-    lex_read_space(0);
-    do_stuff = lex_peek_unichar(0) == '+';
-    if(do_stuff) {
-	lex_read_unichar(0);
-	lex_read_space(0);
-    }
-    c = lex_peek_unichar(0);
-    if(c == ';') {
-	lex_read_unichar(0);
-    } else if(c != /*{*/'}') {
-	croak("syntax error");
-    }
-    if(do_stuff) lex_stuff_pvs(" ", 0);
-    return newOP(OP_NULL, 0);
-}
-
-#define parse_keyword_swaptwostmts() THX_parse_keyword_swaptwostmts(aTHX)
-static OP *THX_parse_keyword_swaptwostmts(pTHX)
-{
-    OP *a, *b;
-    a = parse_fullstmt(0);
-    b = parse_fullstmt(0);
-    if(a && b)
-	PL_hints |= HINT_BLOCK_SCOPE;
-    return op_append_list(OP_LINESEQ, b, a);
-}
-
-#define parse_keyword_looprest() THX_parse_keyword_looprest(aTHX)
-static OP *THX_parse_keyword_looprest(pTHX)
-{
-    return newWHILEOP(0, 1, NULL, newSVOP(OP_CONST, 0, &PL_sv_yes),
-			parse_stmtseq(0), NULL, 1);
-}
-
-#define parse_keyword_scopelessblock() THX_parse_keyword_scopelessblock(aTHX)
-static OP *THX_parse_keyword_scopelessblock(pTHX)
-{
-    I32 c;
-    OP *body;
-    lex_read_space(0);
-    if(lex_peek_unichar(0) != '{'/*}*/) croak("syntax error");
-    lex_read_unichar(0);
-    body = parse_stmtseq(0);
-    c = lex_peek_unichar(0);
-    if(c != /*{*/'}' && c != /*[*/']' && c != /*(*/')') croak("syntax error");
-    lex_read_unichar(0);
-    return body;
-}
-
-#define parse_keyword_stmtasexpr() THX_parse_keyword_stmtasexpr(aTHX)
-static OP *THX_parse_keyword_stmtasexpr(pTHX)
-{
-    OP *o = parse_barestmt(0);
-    if (!o) o = newOP(OP_STUB, 0);
-    if (PL_hints & HINT_BLOCK_SCOPE) o->op_flags |= OPf_PARENS;
-    return op_scope(o);
-}
-
-#define parse_keyword_stmtsasexpr() THX_parse_keyword_stmtsasexpr(aTHX)
-static OP *THX_parse_keyword_stmtsasexpr(pTHX)
-{
-    OP *o;
-    lex_read_space(0);
-    if(lex_peek_unichar(0) != '{'/*}*/) croak("syntax error");
-    lex_read_unichar(0);
-    o = parse_stmtseq(0);
-    lex_read_space(0);
-    if(lex_peek_unichar(0) != /*{*/'}') croak("syntax error");
-    lex_read_unichar(0);
-    if (!o) o = newOP(OP_STUB, 0);
-    if (PL_hints & HINT_BLOCK_SCOPE) o->op_flags |= OPf_PARENS;
-    return op_scope(o);
-}
-
-#define parse_keyword_loopblock() THX_parse_keyword_loopblock(aTHX)
-static OP *THX_parse_keyword_loopblock(pTHX)
-{
-    return newWHILEOP(0, 1, NULL, newSVOP(OP_CONST, 0, &PL_sv_yes),
-			parse_block(0), NULL, 1);
-}
-
-#define parse_keyword_blockasexpr() THX_parse_keyword_blockasexpr(aTHX)
-static OP *THX_parse_keyword_blockasexpr(pTHX)
-{
-    OP *o = parse_block(0);
-    if (!o) o = newOP(OP_STUB, 0);
-    if (PL_hints & HINT_BLOCK_SCOPE) o->op_flags |= OPf_PARENS;
-    return op_scope(o);
-}
-
-#define parse_keyword_swaplabel() THX_parse_keyword_swaplabel(aTHX)
-static OP *THX_parse_keyword_swaplabel(pTHX)
-{
-    OP *sop = parse_barestmt(0);
-    SV *label = parse_label(PARSE_OPTIONAL);
-    if (label) sv_2mortal(label);
-    return newSTATEOP(label ? SvUTF8(label) : 0,
-                      label ? savepv(SvPVX(label)) : NULL,
-                      sop);
-}
-
-#define parse_keyword_labelconst() THX_parse_keyword_labelconst(aTHX)
-static OP *THX_parse_keyword_labelconst(pTHX)
-{
-    return newSVOP(OP_CONST, 0, parse_label(0));
-}
-
-#define parse_keyword_arrayfullexpr() THX_parse_keyword_arrayfullexpr(aTHX)
-static OP *THX_parse_keyword_arrayfullexpr(pTHX)
-{
-    return newANONLIST(parse_fullexpr(0));
-}
-
-#define parse_keyword_arraylistexpr() THX_parse_keyword_arraylistexpr(aTHX)
-static OP *THX_parse_keyword_arraylistexpr(pTHX)
-{
-    return newANONLIST(parse_listexpr(0));
-}
-
-#define parse_keyword_arraytermexpr() THX_parse_keyword_arraytermexpr(aTHX)
-static OP *THX_parse_keyword_arraytermexpr(pTHX)
-{
-    return newANONLIST(parse_termexpr(0));
-}
-
-#define parse_keyword_arrayarithexpr() THX_parse_keyword_arrayarithexpr(aTHX)
-static OP *THX_parse_keyword_arrayarithexpr(pTHX)
-{
-    return newANONLIST(parse_arithexpr(0));
-}
-
-#define parse_keyword_arrayexprflags() THX_parse_keyword_arrayexprflags(aTHX)
-static OP *THX_parse_keyword_arrayexprflags(pTHX)
-{
-    U32 flags = 0;
-    I32 c;
-    OP *o;
-    lex_read_space(0);
-    c = lex_peek_unichar(0);
-    if (c != '!' && c != '?') croak("syntax error");
-    lex_read_unichar(0);
-    if (c == '?') flags |= PARSE_OPTIONAL;
-    o = parse_listexpr(flags);
-    return o ? newANONLIST(o) : newANONHASH(newOP(OP_STUB, 0));
-}
-
-/* plugin glue */
-
-#define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv)
-static int THX_keyword_active(pTHX_ SV *hintkey_sv)
-{
-    HE *he;
-    if(!GvHV(PL_hintgv)) return 0;
-    he = hv_fetch_ent(GvHV(PL_hintgv), hintkey_sv, 0,
-		SvSHARED_HASH(hintkey_sv));
-    return he && SvTRUE(HeVAL(he));
-}
-
-static int my_keyword_plugin(pTHX_
-    char *keyword_ptr, STRLEN keyword_len, OP **op_ptr)
-{
-    if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) &&
-		    keyword_active(hintkey_rpn_sv)) {
-	*op_ptr = parse_keyword_rpn();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) &&
-		    keyword_active(hintkey_calcrpn_sv)) {
-	*op_ptr = parse_keyword_calcrpn();
-	return KEYWORD_PLUGIN_STMT;
-    } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) &&
-		    keyword_active(hintkey_stufftest_sv)) {
-	*op_ptr = parse_keyword_stufftest();
-	return KEYWORD_PLUGIN_STMT;
-    } else if(keyword_len == 12 &&
-		    strnEQ(keyword_ptr, "swaptwostmts", 12) &&
-		    keyword_active(hintkey_swaptwostmts_sv)) {
-	*op_ptr = parse_keyword_swaptwostmts();
-	return KEYWORD_PLUGIN_STMT;
-    } else if(keyword_len == 8 && strnEQ(keyword_ptr, "looprest", 8) &&
-		    keyword_active(hintkey_looprest_sv)) {
-	*op_ptr = parse_keyword_looprest();
-	return KEYWORD_PLUGIN_STMT;
-    } else if(keyword_len == 14 && strnEQ(keyword_ptr, "scopelessblock", 14) &&
-		    keyword_active(hintkey_scopelessblock_sv)) {
-	*op_ptr = parse_keyword_scopelessblock();
-	return KEYWORD_PLUGIN_STMT;
-    } else if(keyword_len == 10 && strnEQ(keyword_ptr, "stmtasexpr", 10) &&
-		    keyword_active(hintkey_stmtasexpr_sv)) {
-	*op_ptr = parse_keyword_stmtasexpr();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 11 && strnEQ(keyword_ptr, "stmtsasexpr", 11) &&
-		    keyword_active(hintkey_stmtsasexpr_sv)) {
-	*op_ptr = parse_keyword_stmtsasexpr();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 9 && strnEQ(keyword_ptr, "loopblock", 9) &&
-		    keyword_active(hintkey_loopblock_sv)) {
-	*op_ptr = parse_keyword_loopblock();
-	return KEYWORD_PLUGIN_STMT;
-    } else if(keyword_len == 11 && strnEQ(keyword_ptr, "blockasexpr", 11) &&
-		    keyword_active(hintkey_blockasexpr_sv)) {
-	*op_ptr = parse_keyword_blockasexpr();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 9 && strnEQ(keyword_ptr, "swaplabel", 9) &&
-		    keyword_active(hintkey_swaplabel_sv)) {
-	*op_ptr = parse_keyword_swaplabel();
-	return KEYWORD_PLUGIN_STMT;
-    } else if(keyword_len == 10 && strnEQ(keyword_ptr, "labelconst", 10) &&
-		    keyword_active(hintkey_labelconst_sv)) {
-	*op_ptr = parse_keyword_labelconst();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arrayfullexpr", 13) &&
-		    keyword_active(hintkey_arrayfullexpr_sv)) {
-	*op_ptr = parse_keyword_arrayfullexpr();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraylistexpr", 13) &&
-		    keyword_active(hintkey_arraylistexpr_sv)) {
-	*op_ptr = parse_keyword_arraylistexpr();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraytermexpr", 13) &&
-		    keyword_active(hintkey_arraytermexpr_sv)) {
-	*op_ptr = parse_keyword_arraytermexpr();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayarithexpr", 14) &&
-		    keyword_active(hintkey_arrayarithexpr_sv)) {
-	*op_ptr = parse_keyword_arrayarithexpr();
-	return KEYWORD_PLUGIN_EXPR;
-    } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayexprflags", 14) &&
-		    keyword_active(hintkey_arrayexprflags_sv)) {
-	*op_ptr = parse_keyword_arrayexprflags();
-	return KEYWORD_PLUGIN_EXPR;
-    } else {
-	return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
-    }
-}
-
-static XOP my_xop;
-
-static OP *
-pp_xop(pTHX)
-{
-    return PL_op->op_next;
-}
-
-static void
-peep_xop(pTHX_ OP *o, OP *oldop)
-{
-    dMY_CXT;
-    av_push(MY_CXT.xop_record, newSVpvf("peep:%"UVxf, PTR2UV(o)));
-    av_push(MY_CXT.xop_record, newSVpvf("oldop:%"UVxf, PTR2UV(oldop)));
-}
-
-static I32
-filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
-{
-    char *p;
-    char *end;
-    int n = FILTER_READ(idx + 1, buf_sv, maxlen);
-
-    if (n<=0) return n;
-
-    p = SvPV_force_nolen(buf_sv);
-    end = p + SvCUR(buf_sv);
-    while (p < end) {
-	if (*p == 'o') *p = 'e';
-	p++;
-    }
-    return SvCUR(buf_sv);
-}
-
-static AV *
-myget_linear_isa(pTHX_ HV *stash, U32 level) {
-    GV **gvp = (GV **)hv_fetchs(stash, "ISA", 0);
-    PERL_UNUSED_ARG(level);
-    return gvp && *gvp && GvAV(*gvp)
-	 ? GvAV(*gvp)
-	 : (AV *)sv_2mortal((SV *)newAV());
-}
-
-
-XS_EXTERNAL(XS_XS__APItest__XSUB_XS_VERSION_undef);
-XS_EXTERNAL(XS_XS__APItest__XSUB_XS_VERSION_empty);
-XS_EXTERNAL(XS_XS__APItest__XSUB_XS_APIVERSION_invalid);
-
-static struct mro_alg mymro;
-
-static Perl_check_t addissub_nxck_add;
-
-static OP *
-addissub_myck_add(pTHX_ OP *op)
-{
-    SV **flag_svp = hv_fetchs(GvHV(PL_hintgv), "XS::APItest/addissub", 0);
-    OP *aop, *bop;
-    U8 flags;
-    if (!(flag_svp && SvTRUE(*flag_svp) && (op->op_flags & OPf_KIDS) &&
-	    (aop = cBINOPx(op)->op_first) && (bop = aop->op_sibling) &&
-	    !bop->op_sibling))
-	return addissub_nxck_add(aTHX_ op);
-    aop->op_sibling = NULL;
-    cBINOPx(op)->op_first = NULL;
-    op->op_flags &= ~OPf_KIDS;
-    flags = op->op_flags;
-    op_free(op);
-    return newBINOP(OP_SUBTRACT, flags, aop, bop);
-}
-
-static Perl_check_t old_ck_rv2cv;
-
-static OP *
-my_ck_rv2cv(pTHX_ OP *o)
-{
-    SV *ref;
-    SV **flag_svp = hv_fetchs(GvHV(PL_hintgv), "XS::APItest/addunder", 0);
-    OP *aop;
-
-    if (flag_svp && SvTRUE(*flag_svp) && (o->op_flags & OPf_KIDS)
-     && (aop = cUNOPx(o)->op_first) && aop->op_type == OP_CONST
-     && aop->op_private & (OPpCONST_ENTERED|OPpCONST_BARE)
-     && (ref = cSVOPx(aop)->op_sv) && SvPOK(ref) && SvCUR(ref)
-     && *(SvEND(ref)-1) == 'o')
-    {
-	SvGROW(ref, SvCUR(ref)+2);
-	*SvEND(ref) = '_';
-	SvCUR(ref)++;
-	*SvEND(ref) = '\0';
-    }
-    return old_ck_rv2cv(aTHX_ o);
-}
-
 #include "const-c.inc"
 
-MODULE = XS::APItest		PACKAGE = XS::APItest
+MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash
 
 INCLUDE: const-xs.inc
 
-INCLUDE: numeric.xs
-
-MODULE = XS::APItest::utf8	PACKAGE = XS::APItest::utf8
-
-int
-bytes_cmp_utf8(bytes, utf8)
-	SV *bytes
-	SV *utf8
-    PREINIT:
-	const U8 *b;
-	STRLEN blen;
-	const U8 *u;
-	STRLEN ulen;
-    CODE:
-	b = (const U8 *)SvPVbyte(bytes, blen);
-	u = (const U8 *)SvPVbyte(utf8, ulen);
-	RETVAL = bytes_cmp_utf8(b, blen, u, ulen);
-    OUTPUT:
-	RETVAL
-
-AV *
-test_utf8n_to_uvchr(s, len, flags)
-
-        SV *s
-        SV *len
-        SV *flags
-    PREINIT:
-        STRLEN retlen;
-        UV ret;
-        STRLEN slen;
-
-    CODE:
-        /* Call utf8n_to_uvchr() with the inputs.  It always asks for the
-         * actual length to be returned
-         *
-         * Length to assume <s> is; not checked, so could have buffer overflow
-         */
-        RETVAL = newAV();
-        sv_2mortal((SV*)RETVAL);
-
-        ret
-         = utf8n_to_uvchr((U8*) SvPV(s, slen), SvUV(len), &retlen, SvUV(flags));
-
-        /* Returns the return value in [0]; <retlen> in [1] */
-        av_push(RETVAL, newSVuv(ret));
-        if (retlen == (STRLEN) -1) {
-            av_push(RETVAL, newSViv(-1));
-        }
-        else {
-            av_push(RETVAL, newSVuv(retlen));
-        }
-
-    OUTPUT:
-        RETVAL
-
-MODULE = XS::APItest:Overload	PACKAGE = XS::APItest::Overload
-
-void
-amagic_deref_call(sv, what)
-	SV *sv
-	int what
-    PPCODE:
-	/* The reference is owned by something else.  */
-	PUSHs(amagic_deref_call(sv, what));
-
-# I'd certainly like to discourage the use of this macro, given that we now
-# have amagic_deref_call
-
-void
-tryAMAGICunDEREF_var(sv, what)
-	SV *sv
-	int what
-    PPCODE:
-	{
-	    SV **sp = &sv;
-	    switch(what) {
-	    case to_av_amg:
-		tryAMAGICunDEREF(to_av);
-		break;
-	    case to_cv_amg:
-		tryAMAGICunDEREF(to_cv);
-		break;
-	    case to_gv_amg:
-		tryAMAGICunDEREF(to_gv);
-		break;
-	    case to_hv_amg:
-		tryAMAGICunDEREF(to_hv);
-		break;
-	    case to_sv_amg:
-		tryAMAGICunDEREF(to_sv);
-		break;
-	    default:
-		croak("Invalid value %d passed to tryAMAGICunDEREF_var", what);
-	    }
-	}
-	/* The reference is owned by something else.  */
-	PUSHs(sv);
-
-MODULE = XS::APItest		PACKAGE = XS::APItest::XSUB
-
-BOOT:
-    newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__);
-    newXS("XS::APItest::XSUB::XS_VERSION_empty", XS_XS__APItest__XSUB_XS_VERSION_empty, __FILE__);
-    newXS("XS::APItest::XSUB::XS_APIVERSION_invalid", XS_XS__APItest__XSUB_XS_APIVERSION_invalid, __FILE__);
-
-void
-XS_VERSION_defined(...)
-    PPCODE:
-        XS_VERSION_BOOTCHECK;
-        XSRETURN_EMPTY;
-
-void
-XS_APIVERSION_valid(...)
-    PPCODE:
-        XS_APIVERSION_BOOTCHECK;
-        XSRETURN_EMPTY;
-
-MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash
-
 void
 rot13_hash(hash)
 	HV *hash
@@ -1517,7 +512,9 @@ refcounted_he_exists(key, level=0)
 	if (level) {
 	    croak("level must be zero, not %"IVdf, level);
 	}
-	RETVAL = (cop_hints_fetch_sv(PL_curcop, key, 0, 0) != &PL_sv_placeholder);
+	RETVAL = (Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
+					   key, NULL, 0, 0, 0)
+		  != &PL_sv_placeholder);
 	OUTPUT:
 	RETVAL
 
@@ -1529,29 +526,14 @@ refcounted_he_fetch(key, level=0)
 	if (level) {
 	    croak("level must be zero, not %"IVdf, level);
 	}
-	RETVAL = cop_hints_fetch_sv(PL_curcop, key, 0, 0);
+	RETVAL = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, key,
+					  NULL, 0, 0, 0);
 	SvREFCNT_inc(RETVAL);
 	OUTPUT:
 	RETVAL
-
+	
 #endif
-
-void
-test_force_keys(HV *hv)
-    PREINIT:
-        HE *he;
-	STRLEN count = 0;
-    PPCODE:
-        hv_iterinit(hv);
-        he = hv_iternext(hv);
-        while (he) {
-	    SV *sv = HeSVKEY_force(he);
-	    ++count;
-	    EXTEND(SP, count);
-	    PUSHs(sv_mortalcopy(sv));
-            he = hv_iternext(hv);
-        }
-
+	
 =pod
 
 sub TIEHASH  { bless {}, $_[0] }
@@ -1565,264 +547,22 @@ sub CLEAR    { %{$_[0]} = () }
 
 =cut
 
-MODULE = XS::APItest:TempLv		PACKAGE = XS::APItest::TempLv
-
-void
-make_temp_mg_lv(sv)
-SV* sv
-    PREINIT:
-	SV * const lv = newSV_type(SVt_PVLV);
-	STRLEN len;
-    PPCODE:
-        SvPV(sv, len);
-
-	sv_magic(lv, NULL, PERL_MAGIC_substr, NULL, 0);
-	LvTYPE(lv) = 'x';
-	LvTARG(lv) = SvREFCNT_inc_simple(sv);
-	LvTARGOFF(lv) = len == 0 ? 0 : 1;
-	LvTARGLEN(lv) = len < 2 ? 0 : len-2;
-
-	EXTEND(SP, 1);
-	ST(0) = sv_2mortal(lv);
-	XSRETURN(1);
-
-
-MODULE = XS::APItest::PtrTable	PACKAGE = XS::APItest::PtrTable PREFIX = ptr_table_
-
-void
-ptr_table_new(classname)
-const char * classname
-    PPCODE:
-    PUSHs(sv_setref_pv(sv_newmortal(), classname, (void*)ptr_table_new()));
-
-void
-DESTROY(table)
-XS::APItest::PtrTable table
-    CODE:
-    ptr_table_free(table);
-
-void
-ptr_table_store(table, from, to)
-XS::APItest::PtrTable table
-SVREF from
-SVREF to
-   CODE:
-   ptr_table_store(table, from, to);
-
-UV
-ptr_table_fetch(table, from)
-XS::APItest::PtrTable table
-SVREF from
-   CODE:
-   RETVAL = PTR2UV(ptr_table_fetch(table, from));
-   OUTPUT:
-   RETVAL
-
-void
-ptr_table_split(table)
-XS::APItest::PtrTable table
-
-void
-ptr_table_clear(table)
-XS::APItest::PtrTable table
-
-MODULE = XS::APItest::AutoLoader	PACKAGE = XS::APItest::AutoLoader
-
-SV *
-AUTOLOAD()
-    CODE:
-	RETVAL = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SvUTF8(cv));
-    OUTPUT:
-	RETVAL
-
-SV *
-AUTOLOADp(...)
-    PROTOTYPE: *$
-    CODE:
-        PERL_UNUSED_ARG(items);
-	RETVAL = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SvUTF8(cv));
-    OUTPUT:
-	RETVAL
-
-
 MODULE = XS::APItest		PACKAGE = XS::APItest
 
 PROTOTYPES: DISABLE
 
 BOOT:
-    mymro.resolve = myget_linear_isa;
-    mymro.name    = "justisa";
-    mymro.length  = 7;
-    mymro.kflags  = 0;
-    mymro.hash    = 0;
-    Perl_mro_register(aTHX_ &mymro);
-
-HV *
-xop_custom_ops ()
-    CODE:
-        RETVAL = PL_custom_ops;
-    OUTPUT:
-        RETVAL
-
-HV *
-xop_custom_op_names ()
-    CODE:
-        PL_custom_op_names = newHV();
-        RETVAL = PL_custom_op_names;
-    OUTPUT:
-        RETVAL
-
-HV *
-xop_custom_op_descs ()
-    CODE:
-        PL_custom_op_descs = newHV();
-        RETVAL = PL_custom_op_descs;
-    OUTPUT:
-        RETVAL
-
-void
-xop_register ()
-    CODE:
-        XopENTRY_set(&my_xop, xop_name, "my_xop");
-        XopENTRY_set(&my_xop, xop_desc, "XOP for testing");
-        XopENTRY_set(&my_xop, xop_class, OA_UNOP);
-        XopENTRY_set(&my_xop, xop_peep, peep_xop);
-        Perl_custom_op_register(aTHX_ pp_xop, &my_xop);
-
-void
-xop_clear ()
-    CODE:
-        XopDISABLE(&my_xop, xop_name);
-        XopDISABLE(&my_xop, xop_desc);
-        XopDISABLE(&my_xop, xop_class);
-        XopDISABLE(&my_xop, xop_peep);
-
-IV
-xop_my_xop ()
-    CODE:
-        RETVAL = PTR2IV(&my_xop);
-    OUTPUT:
-        RETVAL
-
-IV
-xop_ppaddr ()
-    CODE:
-        RETVAL = PTR2IV(pp_xop);
-    OUTPUT:
-        RETVAL
-
-IV
-xop_OA_UNOP ()
-    CODE:
-        RETVAL = OA_UNOP;
-    OUTPUT:
-        RETVAL
-
-AV *
-xop_build_optree ()
-    CODE:
-        dMY_CXT;
-        UNOP *unop;
-        OP *kid;
-
-        MY_CXT.xop_record = newAV();
-
-        kid = newSVOP(OP_CONST, 0, newSViv(42));
-        
-        NewOp(1102, unop, 1, UNOP);
-        unop->op_type       = OP_CUSTOM;
-        unop->op_ppaddr     = pp_xop;
-        unop->op_flags      = OPf_KIDS;
-        unop->op_private    = 0;
-        unop->op_first      = kid;
-        unop->op_next       = NULL;
-        kid->op_next        = (OP*)unop;
-
-        av_push(MY_CXT.xop_record, newSVpvf("unop:%"UVxf, PTR2UV(unop)));
-        av_push(MY_CXT.xop_record, newSVpvf("kid:%"UVxf, PTR2UV(kid)));
-
-        av_push(MY_CXT.xop_record, newSVpvf("NAME:%s", OP_NAME((OP*)unop)));
-        av_push(MY_CXT.xop_record, newSVpvf("DESC:%s", OP_DESC((OP*)unop)));
-        av_push(MY_CXT.xop_record, newSVpvf("CLASS:%d", (int)OP_CLASS((OP*)unop)));
-
-        PL_rpeepp(aTHX_ kid);
-
-        FreeOp(kid);
-        FreeOp(unop);
-
-        RETVAL = MY_CXT.xop_record;
-        MY_CXT.xop_record = NULL;
-    OUTPUT:
-        RETVAL
-
-IV
-xop_from_custom_op ()
-    CODE:
-/* author note: this test doesn't imply Perl_custom_op_xop is or isn't public
-   API or that Perl_custom_op_xop is known to be used outside the core */
-        UNOP *unop;
-        XOP *xop;
-
-        NewOp(1102, unop, 1, UNOP);
-        unop->op_type       = OP_CUSTOM;
-        unop->op_ppaddr     = pp_xop;
-        unop->op_flags      = OPf_KIDS;
-        unop->op_private    = 0;
-        unop->op_first      = NULL;
-        unop->op_next       = NULL;
-
-        xop = Perl_custom_op_xop(aTHX_ (OP *)unop);
-        FreeOp(unop);
-        RETVAL = PTR2IV(xop);
-    OUTPUT:
-        RETVAL
-
-BOOT:
 {
     MY_CXT_INIT;
-
     MY_CXT.i  = 99;
     MY_CXT.sv = newSVpv("initial",0);
-
-    MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
-    MY_CXT.bhk_record = 0;
-
-    BhkENTRY_set(&bhk_test, bhk_start, blockhook_test_start);
-    BhkENTRY_set(&bhk_test, bhk_pre_end, blockhook_test_pre_end);
-    BhkENTRY_set(&bhk_test, bhk_post_end, blockhook_test_post_end);
-    BhkENTRY_set(&bhk_test, bhk_eval, blockhook_test_eval);
-    Perl_blockhook_register(aTHX_ &bhk_test);
-
-    MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER",
-        GV_ADDMULTI, SVt_PVAV);
-    MY_CXT.cscav = GvAV(MY_CXT.cscgv);
-
-    BhkENTRY_set(&bhk_csc, bhk_start, blockhook_csc_start);
-    BhkENTRY_set(&bhk_csc, bhk_pre_end, blockhook_csc_pre_end);
-    Perl_blockhook_register(aTHX_ &bhk_csc);
-
-    MY_CXT.peep_recorder = newAV();
-    MY_CXT.rpeep_recorder = newAV();
-
-    MY_CXT.orig_peep = PL_peepp;
-    MY_CXT.orig_rpeep = PL_rpeepp;
-    PL_peepp = my_peep;
-    PL_rpeepp = my_rpeep;
-}
+}                              
 
 void
 CLONE(...)
     CODE:
     MY_CXT_CLONE;
-    PERL_UNUSED_VAR(items);
     MY_CXT.sv = newSVpv("initial_clone",0);
-    MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER",
-        GV_ADDMULTI, SVt_PVAV);
-    MY_CXT.cscav = NULL;
-    MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
-    MY_CXT.bhk_record = 0;
-    MY_CXT.peep_recorder = newAV();
-    MY_CXT.rpeep_recorder = newAV();
 
 void
 print_double(val)
@@ -1945,81 +685,6 @@ mxpushu()
 	mXPUSHu(3);
 	XSRETURN(3);
 
-void
-call_sv_C()
-PREINIT:
-    CV * i_sub;
-    GV * i_gv;
-    I32 retcnt;
-    SV * errsv;
-    char * errstr;
-    SV * miscsv = sv_newmortal();
-    HV * hv = (HV*)sv_2mortal((SV*)newHV());
-CODE:
-    i_sub = get_cv("i", 0);
-    PUSHMARK(SP);
-    /* PUTBACK not needed since this sub was called with 0 args, and is calling
-      0 args, so global SP doesn't need to be moved before a call_* */
-    retcnt = call_sv((SV*)i_sub, 0); /* try a CV* */
-    SPAGAIN;
-    SP -= retcnt; /* dont care about return count, wipe everything off */
-    sv_setpvs(miscsv, "i");
-    PUSHMARK(SP);
-    retcnt = call_sv(miscsv, 0); /* try a PV */
-    SPAGAIN;
-    SP -= retcnt;
-    /* no add and SVt_NULL are intentional, sub i should be defined already */
-    i_gv = gv_fetchpvn_flags("i", sizeof("i")-1, 0, SVt_NULL);
-    PUSHMARK(SP);
-    retcnt = call_sv((SV*)i_gv, 0); /* try a GV* */
-    SPAGAIN;
-    SP -= retcnt;
-    /* the tests below are not declaring this being public API behavior,
-       only current internal behavior, these tests can be changed in the
-       future if necessery */
-    PUSHMARK(SP);
-    retcnt = call_sv(&PL_sv_yes, 0); /* does nothing */
-    SPAGAIN;
-    SP -= retcnt;
-    PUSHMARK(SP);
-    retcnt = call_sv(&PL_sv_no, G_EVAL);
-    SPAGAIN;
-    SP -= retcnt;
-    errsv = ERRSV;
-    errstr = SvPV_nolen(errsv);
-    if(strnEQ(errstr, "Undefined subroutine &main:: called at",
-              sizeof("Undefined subroutine &main:: called at") - 1)) {
-        PUSHMARK(SP);
-        retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
-        SPAGAIN;
-        SP -= retcnt;
-    }
-    PUSHMARK(SP);
-    retcnt = call_sv(&PL_sv_undef,  G_EVAL);
-    SPAGAIN;
-    SP -= retcnt;
-    errsv = ERRSV;
-    errstr = SvPV_nolen(errsv);
-    if(strnEQ(errstr, "Can't use an undefined value as a subroutine reference at",
-              sizeof("Can't use an undefined value as a subroutine reference at") - 1)) {
-        PUSHMARK(SP);
-        retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
-        SPAGAIN;
-        SP -= retcnt;
-    }
-    PUSHMARK(SP);
-    retcnt = call_sv((SV*)hv,  G_EVAL);
-    SPAGAIN;
-    SP -= retcnt;
-    errsv = ERRSV;
-    errstr = SvPV_nolen(errsv);
-    if(strnEQ(errstr, "Not a CODE reference at",
-              sizeof("Not a CODE reference at") - 1)) {
-        PUSHMARK(SP);
-        retcnt = call_sv((SV*)i_sub, 0); /* call again to increase counter */
-        SPAGAIN;
-        SP -= retcnt;
-    }
 
 void
 call_sv(sv, flags, ...)
@@ -2073,200 +738,6 @@ call_method(methname, flags, ...)
 	PUSHs(sv_2mortal(newSViv(i)));
 
 void
-newCONSTSUB(stash, name, flags, sv)
-    HV* stash
-    SV* name
-    I32 flags
-    SV* sv
-    ALIAS:
-	newCONSTSUB_flags = 1
-    PREINIT:
-	CV* mycv = NULL;
-	STRLEN len;
-	const char *pv = SvPV(name, len);
-    PPCODE:
-        switch (ix) {
-           case 0:
-               mycv = newCONSTSUB(stash, pv, SvOK(sv) ? SvREFCNT_inc(sv) : NULL);
-               break;
-           case 1:
-               mycv = newCONSTSUB_flags(
-                 stash, pv, len, flags | SvUTF8(name), SvOK(sv) ? SvREFCNT_inc(sv) : NULL
-               );
-               break;
-        }
-        EXTEND(SP, 2);
-        PUSHs( CvCONST(mycv) ? &PL_sv_yes : &PL_sv_no );
-        PUSHs((SV*)CvGV(mycv));
-
-void
-gv_init_type(namesv, multi, flags, type)
-    SV* namesv
-    int multi
-    I32 flags
-    int type
-    PREINIT:
-        STRLEN len;
-        const char * const name = SvPV_const(namesv, len);
-        GV *gv = *(GV**)hv_fetch(PL_defstash, name, len, TRUE);
-    PPCODE:
-        if (SvTYPE(gv) == SVt_PVGV)
-            Perl_croak(aTHX_ "GV is already a PVGV");
-        if (multi) flags |= GV_ADDMULTI;
-        switch (type) {
-           case 0:
-	       gv_init(gv, PL_defstash, name, len, multi);
-               break;
-           case 1:
-               gv_init_sv(gv, PL_defstash, namesv, flags);
-               break;
-           case 2:
-               gv_init_pv(gv, PL_defstash, name, flags | SvUTF8(namesv));
-               break;
-           case 3:
-               gv_init_pvn(gv, PL_defstash, name, len, flags | SvUTF8(namesv));
-               break;
-        }
-	XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
-
-void
-gv_fetchmeth_type(stash, methname, type, level, flags)
-    HV* stash
-    SV* methname
-    int type
-    I32 level
-    I32 flags
-    PREINIT:
-        STRLEN len;
-        const char * const name = SvPV_const(methname, len);
-	GV* gv = NULL;
-    PPCODE:
-        switch (type) {
-           case 0:
-	       gv = gv_fetchmeth(stash, name, len, level);
-               break;
-           case 1:
-               gv = gv_fetchmeth_sv(stash, methname, level, flags);
-               break;
-           case 2:
-               gv = gv_fetchmeth_pv(stash, name, level, flags | SvUTF8(methname));
-               break;
-           case 3:
-               gv = gv_fetchmeth_pvn(stash, name, len, level, flags | SvUTF8(methname));
-               break;
-        }
-	XPUSHs( gv ? MUTABLE_SV(gv) : &PL_sv_undef );
-
-void
-gv_fetchmeth_autoload_type(stash, methname, type, level, flags)
-    HV* stash
-    SV* methname
-    int type
-    I32 level
-    I32 flags
-    PREINIT:
-        STRLEN len;
-        const char * const name = SvPV_const(methname, len);
-	GV* gv = NULL;
-    PPCODE:
-        switch (type) {
-           case 0:
-	       gv = gv_fetchmeth_autoload(stash, name, len, level);
-               break;
-           case 1:
-               gv = gv_fetchmeth_sv_autoload(stash, methname, level, flags);
-               break;
-           case 2:
-               gv = gv_fetchmeth_pv_autoload(stash, name, level, flags | SvUTF8(methname));
-               break;
-           case 3:
-               gv = gv_fetchmeth_pvn_autoload(stash, name, len, level, flags | SvUTF8(methname));
-               break;
-        }
-	XPUSHs( gv ? MUTABLE_SV(gv) : &PL_sv_undef );
-
-void
-gv_fetchmethod_flags_type(stash, methname, type, flags)
-    HV* stash
-    SV* methname
-    int type
-    I32 flags
-    PREINIT:
-	GV* gv = NULL;
-    PPCODE:
-        switch (type) {
-           case 0:
-	       gv = gv_fetchmethod_flags(stash, SvPVX_const(methname), flags);
-               break;
-           case 1:
-               gv = gv_fetchmethod_sv_flags(stash, methname, flags);
-               break;
-           case 2:
-               gv = gv_fetchmethod_pv_flags(stash, SvPV_nolen(methname), flags | SvUTF8(methname));
-               break;
-           case 3: {
-               STRLEN len;
-               const char * const name = SvPV_const(methname, len);
-               gv = gv_fetchmethod_pvn_flags(stash, name, len, flags | SvUTF8(methname));
-               break;
-            }
-        }
-	XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
-
-void
-gv_autoload_type(stash, methname, type, method)
-    HV* stash
-    SV* methname
-    int type
-    I32 method
-    PREINIT:
-        STRLEN len;
-        const char * const name = SvPV_const(methname, len);
-	GV* gv = NULL;
-	I32 flags = method ? GV_AUTOLOAD_ISMETHOD : 0;
-    PPCODE:
-        switch (type) {
-           case 0:
-	       gv = gv_autoload4(stash, name, len, method);
-               break;
-           case 1:
-               gv = gv_autoload_sv(stash, methname, flags);
-               break;
-           case 2:
-               gv = gv_autoload_pv(stash, name, flags | SvUTF8(methname));
-               break;
-           case 3:
-               gv = gv_autoload_pvn(stash, name, len, flags | SvUTF8(methname));
-               break;
-        }
-	XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
-
-void
-whichsig_type(namesv, type)
-    SV* namesv
-    int type
-    PREINIT:
-        STRLEN len;
-        const char * const name = SvPV_const(namesv, len);
-        I32 i = 0;
-    PPCODE:
-        switch (type) {
-           case 0:
-              i = whichsig(name);
-               break;
-           case 1:
-               i = whichsig_sv(namesv);
-               break;
-           case 2:
-               i = whichsig_pv(name);
-               break;
-           case 3:
-               i = whichsig_pvn(name, len);
-               break;
-        }
-        XPUSHs(sv_2mortal(newSViv(i)));
-
-void
 eval_sv(sv, flags)
     SV* sv
     I32 flags
@@ -2358,21 +829,6 @@ bool
 sv_setsv_cow_hashkey_notcore()
 
 void
-sv_set_deref(SV *sv, SV *sv2, int which)
-    CODE:
-    {
-	STRLEN len;
-	const char *pv = SvPV(sv2,len);
-	if (!SvROK(sv)) croak("Not a ref");
-	sv = SvRV(sv);
-	switch (which) {
-	    case 0: sv_setsv(sv,sv2); break;
-	    case 1: sv_setpv(sv,pv); break;
-	    case 2: sv_setpvn(sv,pv,len); break;
-	}
-    }
-
-void
 rmagical_cast(sv, type)
     SV *sv;
     SV *type;
@@ -2405,38 +861,6 @@ rmagical_flags(sv)
         XSRETURN(3);
 
 void
-my_caller(level)
-        I32 level
-    PREINIT:
-        const PERL_CONTEXT *cx, *dbcx;
-        const char *pv;
-        const GV *gv;
-        HV *hv;
-    PPCODE:
-        cx = caller_cx(level, &dbcx);
-        EXTEND(SP, 8);
-
-        pv = CopSTASHPV(cx->blk_oldcop);
-        ST(0) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
-        gv = CvGV(cx->blk_sub.cv);
-        ST(1) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
-
-        pv = CopSTASHPV(dbcx->blk_oldcop);
-        ST(2) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
-        gv = CvGV(dbcx->blk_sub.cv);
-        ST(3) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
-
-        ST(4) = cop_hints_fetch_pvs(cx->blk_oldcop, "foo", 0);
-        ST(5) = cop_hints_fetch_pvn(cx->blk_oldcop, "foo", 3, 0, 0);
-        ST(6) = cop_hints_fetch_sv(cx->blk_oldcop, 
-                sv_2mortal(newSVpvn("foo", 3)), 0, 0);
-
-        hv = cop_hints_2hv(cx->blk_oldcop, 0);
-        ST(7) = hv ? sv_2mortal(newRV_noinc((SV *)hv)) : &PL_sv_undef;
-
-        XSRETURN(8);
-
-void
 DPeek (sv)
     SV   *sv
 
@@ -2468,2327 +892,3 @@ void
 END()
     CODE:
 	sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));
-
-void
-utf16_to_utf8 (sv, ...)
-    SV* sv
-	ALIAS:
-	    utf16_to_utf8_reversed = 1
-    PREINIT:
-        STRLEN len;
-	U8 *source;
-	SV *dest;
-	I32 got; /* Gah, badly thought out APIs */
-    CODE:
-	if (ix) (void)SvPV_force_nolen(sv);
-	source = (U8 *)SvPVbyte(sv, len);
-	/* Optionally only convert part of the buffer.  */ 	
-	if (items > 1) {
-	    len = SvUV(ST(1));
- 	}
-	/* Mortalise this right now, as we'll be testing croak()s  */
-	dest = sv_2mortal(newSV(len * 3 / 2 + 1));
-	if (ix) {
-	    utf16_to_utf8_reversed(source, (U8 *)SvPVX(dest), len, &got);
-	} else {
-	    utf16_to_utf8(source, (U8 *)SvPVX(dest), len, &got);
-	}
-	SvCUR_set(dest, got);
-	SvPVX(dest)[got] = '\0';
-	SvPOK_on(dest);
- 	ST(0) = dest;
-	XSRETURN(1);
-
-void
-my_exit(int exitcode)
-        PPCODE:
-        my_exit(exitcode);
-
-U8
-first_byte(sv)
-	SV *sv
-   CODE:
-    char *s;
-    STRLEN len;
-	s = SvPVbyte(sv, len);
-	RETVAL = s[0];
-   OUTPUT:
-    RETVAL
-
-I32
-sv_count()
-        CODE:
-	    RETVAL = PL_sv_count;
-	OUTPUT:
-	    RETVAL
-
-void
-bhk_record(bool on)
-    CODE:
-        dMY_CXT;
-        MY_CXT.bhk_record = on;
-        if (on)
-            av_clear(MY_CXT.bhkav);
-
-void
-test_magic_chain()
-    PREINIT:
-	SV *sv;
-	MAGIC *callmg, *uvarmg;
-    CODE:
-	sv = sv_2mortal(newSV(0));
-	if (SvTYPE(sv) >= SVt_PVMG) croak_fail();
-	if (SvMAGICAL(sv)) croak_fail();
-	sv_magic(sv, &PL_sv_yes, PERL_MAGIC_checkcall, (char*)&callmg, 0);
-	if (SvTYPE(sv) < SVt_PVMG) croak_fail();
-	if (!SvMAGICAL(sv)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_uvar)) croak_fail();
-	callmg = mg_find(sv, PERL_MAGIC_checkcall);
-	if (!callmg) croak_fail();
-	if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
-	    croak_fail();
-	sv_magic(sv, &PL_sv_no, PERL_MAGIC_uvar, (char*)&uvarmg, 0);
-	if (SvTYPE(sv) < SVt_PVMG) croak_fail();
-	if (!SvMAGICAL(sv)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
-	uvarmg = mg_find(sv, PERL_MAGIC_uvar);
-	if (!uvarmg) croak_fail();
-	if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
-	    croak_fail();
-	if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
-	    croak_fail();
-	mg_free_type(sv, PERL_MAGIC_vec);
-	if (SvTYPE(sv) < SVt_PVMG) croak_fail();
-	if (!SvMAGICAL(sv)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_uvar) != uvarmg) croak_fail();
-	if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
-	    croak_fail();
-	if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
-	    croak_fail();
-	mg_free_type(sv, PERL_MAGIC_uvar);
-	if (SvTYPE(sv) < SVt_PVMG) croak_fail();
-	if (!SvMAGICAL(sv)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_uvar)) croak_fail();
-	if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
-	    croak_fail();
-	sv_magic(sv, &PL_sv_no, PERL_MAGIC_uvar, (char*)&uvarmg, 0);
-	if (SvTYPE(sv) < SVt_PVMG) croak_fail();
-	if (!SvMAGICAL(sv)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
-	uvarmg = mg_find(sv, PERL_MAGIC_uvar);
-	if (!uvarmg) croak_fail();
-	if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
-	    croak_fail();
-	if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
-	    croak_fail();
-	mg_free_type(sv, PERL_MAGIC_checkcall);
-	if (SvTYPE(sv) < SVt_PVMG) croak_fail();
-	if (!SvMAGICAL(sv)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_uvar) != uvarmg) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_checkcall)) croak_fail();
-	if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
-	    croak_fail();
-	mg_free_type(sv, PERL_MAGIC_uvar);
-	if (SvMAGICAL(sv)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_checkcall)) croak_fail();
-	if (mg_find(sv, PERL_MAGIC_uvar)) croak_fail();
-
-void
-test_op_contextualize()
-    PREINIT:
-	OP *o;
-    CODE:
-	o = newSVOP(OP_CONST, 0, newSViv(0));
-	o->op_flags &= ~OPf_WANT;
-	o = op_contextualize(o, G_SCALAR);
-	if (o->op_type != OP_CONST ||
-		(o->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
-	    croak_fail();
-	op_free(o);
-	o = newSVOP(OP_CONST, 0, newSViv(0));
-	o->op_flags &= ~OPf_WANT;
-	o = op_contextualize(o, G_ARRAY);
-	if (o->op_type != OP_CONST ||
-		(o->op_flags & OPf_WANT) != OPf_WANT_LIST)
-	    croak_fail();
-	op_free(o);
-	o = newSVOP(OP_CONST, 0, newSViv(0));
-	o->op_flags &= ~OPf_WANT;
-	o = op_contextualize(o, G_VOID);
-	if (o->op_type != OP_NULL) croak_fail();
-	op_free(o);
-
-void
-test_rv2cv_op_cv()
-    PROTOTYPE:
-    PREINIT:
-	GV *troc_gv;
-	CV *troc_cv;
-	OP *o;
-    CODE:
-	troc_gv = gv_fetchpv("XS::APItest::test_rv2cv_op_cv", 0, SVt_PVGV);
-	troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
-	o = newCVREF(0, newGVOP(OP_GV, 0, troc_gv));
-	if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
-	    croak_fail();
-	o->op_private |= OPpENTERSUB_AMPER;
-	if (rv2cv_op_cv(o, 0)) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
-	o->op_private &= ~OPpENTERSUB_AMPER;
-	if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY) != troc_cv) croak_fail();
-	if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
-	op_free(o);
-	o = newSVOP(OP_CONST, 0, newSVpv("XS::APItest::test_rv2cv_op_cv", 0));
-	o->op_private = OPpCONST_BARE;
-	o = newCVREF(0, o);
-	if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
-	    croak_fail();
-	o->op_private |= OPpENTERSUB_AMPER;
-	if (rv2cv_op_cv(o, 0)) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
-	op_free(o);
-	o = newCVREF(0, newSVOP(OP_CONST, 0, newRV_inc((SV*)troc_cv)));
-	if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
-	    croak_fail();
-	o->op_private |= OPpENTERSUB_AMPER;
-	if (rv2cv_op_cv(o, 0)) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
-	o->op_private &= ~OPpENTERSUB_AMPER;
-	if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY) != troc_cv) croak_fail();
-	if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
-	op_free(o);
-	o = newCVREF(0, newUNOP(OP_RAND, 0, newSVOP(OP_CONST, 0, newSViv(0))));
-	if (rv2cv_op_cv(o, 0)) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
-	o->op_private |= OPpENTERSUB_AMPER;
-	if (rv2cv_op_cv(o, 0)) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
-	o->op_private &= ~OPpENTERSUB_AMPER;
-	if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY)) croak_fail();
-	if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
-	op_free(o);
-	o = newUNOP(OP_RAND, 0, newSVOP(OP_CONST, 0, newSViv(0)));
-	if (rv2cv_op_cv(o, 0)) croak_fail();
-	if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
-	op_free(o);
-
-void
-test_cv_getset_call_checker()
-    PREINIT:
-	CV *troc_cv, *tsh_cv;
-	Perl_call_checker ckfun;
-	SV *ckobj;
-    CODE:
-#define check_cc(cv, xckfun, xckobj) \
-    do { \
-	cv_get_call_checker((cv), &ckfun, &ckobj); \
-	if (ckfun != (xckfun)) croak_fail_ne(FPTR2DPTR(void *, ckfun), xckfun); \
-	if (ckobj != (xckobj)) croak_fail_ne(FPTR2DPTR(void *, ckobj), xckobj); \
-    } while(0)
-	troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
-	tsh_cv = get_cv("XS::APItest::test_savehints", 0);
-	check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
-	check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
-	cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
-				    &PL_sv_yes);
-	check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
-	check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
-	cv_set_call_checker(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
-	check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
-	check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
-	cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
-				    (SV*)tsh_cv);
-	check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
-	check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
-	cv_set_call_checker(troc_cv, Perl_ck_entersub_args_proto_or_list,
-				    (SV*)troc_cv);
-	check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
-	check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
-	if (SvMAGICAL((SV*)troc_cv) || SvMAGIC((SV*)troc_cv)) croak_fail();
-	if (SvMAGICAL((SV*)tsh_cv) || SvMAGIC((SV*)tsh_cv)) croak_fail();
-#undef check_cc
-
-void
-cv_set_call_checker_lists(CV *cv)
-    CODE:
-	cv_set_call_checker(cv, THX_ck_entersub_args_lists, &PL_sv_undef);
-
-void
-cv_set_call_checker_scalars(CV *cv)
-    CODE:
-	cv_set_call_checker(cv, THX_ck_entersub_args_scalars, &PL_sv_undef);
-
-void
-cv_set_call_checker_proto(CV *cv, SV *proto)
-    CODE:
-	if (SvROK(proto))
-	    proto = SvRV(proto);
-	cv_set_call_checker(cv, Perl_ck_entersub_args_proto, proto);
-
-void
-cv_set_call_checker_proto_or_list(CV *cv, SV *proto)
-    CODE:
-	if (SvROK(proto))
-	    proto = SvRV(proto);
-	cv_set_call_checker(cv, Perl_ck_entersub_args_proto_or_list, proto);
-
-void
-cv_set_call_checker_multi_sum(CV *cv)
-    CODE:
-	cv_set_call_checker(cv, THX_ck_entersub_multi_sum, &PL_sv_undef);
-
-void
-test_cophh()
-    PREINIT:
-	COPHH *a, *b;
-    CODE:
-#define check_ph(EXPR) \
-    	    do { if((EXPR) != &PL_sv_placeholder) croak("fail"); } while(0)
-#define check_iv(EXPR, EXPECT) \
-    	    do { if(SvIV(EXPR) != (EXPECT)) croak("fail"); } while(0)
-#define msvpvs(STR) sv_2mortal(newSVpvs(STR))
-#define msviv(VALUE) sv_2mortal(newSViv(VALUE))
-	a = cophh_new_empty();
-	check_ph(cophh_fetch_pvn(a, "foo_1", 5, 0, 0));
-	check_ph(cophh_fetch_pvs(a, "foo_1", 0));
-	check_ph(cophh_fetch_pv(a, "foo_1", 0, 0));
-	check_ph(cophh_fetch_sv(a, msvpvs("foo_1"), 0, 0));
-	a = cophh_store_pvn(a, "foo_1abc", 5, 0, msviv(111), 0);
-	a = cophh_store_pvs(a, "foo_2", msviv(222), 0);
-	a = cophh_store_pv(a, "foo_3", 0, msviv(333), 0);
-	a = cophh_store_sv(a, msvpvs("foo_4"), 0, msviv(444), 0);
-	check_iv(cophh_fetch_pvn(a, "foo_1xyz", 5, 0, 0), 111);
-	check_iv(cophh_fetch_pvs(a, "foo_1", 0), 111);
-	check_iv(cophh_fetch_pv(a, "foo_1", 0, 0), 111);
-	check_iv(cophh_fetch_sv(a, msvpvs("foo_1"), 0, 0), 111);
-	check_iv(cophh_fetch_pvs(a, "foo_2", 0), 222);
-	check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
-	check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
-	check_ph(cophh_fetch_pvs(a, "foo_5", 0));
-	b = cophh_copy(a);
-	b = cophh_store_pvs(b, "foo_1", msviv(1111), 0);
-	check_iv(cophh_fetch_pvs(a, "foo_1", 0), 111);
-	check_iv(cophh_fetch_pvs(a, "foo_2", 0), 222);
-	check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
-	check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
-	check_ph(cophh_fetch_pvs(a, "foo_5", 0));
-	check_iv(cophh_fetch_pvs(b, "foo_1", 0), 1111);
-	check_iv(cophh_fetch_pvs(b, "foo_2", 0), 222);
-	check_iv(cophh_fetch_pvs(b, "foo_3", 0), 333);
-	check_iv(cophh_fetch_pvs(b, "foo_4", 0), 444);
-	check_ph(cophh_fetch_pvs(b, "foo_5", 0));
-	a = cophh_delete_pvn(a, "foo_1abc", 5, 0, 0);
-	a = cophh_delete_pvs(a, "foo_2", 0);
-	b = cophh_delete_pv(b, "foo_3", 0, 0);
-	b = cophh_delete_sv(b, msvpvs("foo_4"), 0, 0);
-	check_ph(cophh_fetch_pvs(a, "foo_1", 0));
-	check_ph(cophh_fetch_pvs(a, "foo_2", 0));
-	check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
-	check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
-	check_ph(cophh_fetch_pvs(a, "foo_5", 0));
-	check_iv(cophh_fetch_pvs(b, "foo_1", 0), 1111);
-	check_iv(cophh_fetch_pvs(b, "foo_2", 0), 222);
-	check_ph(cophh_fetch_pvs(b, "foo_3", 0));
-	check_ph(cophh_fetch_pvs(b, "foo_4", 0));
-	check_ph(cophh_fetch_pvs(b, "foo_5", 0));
-	b = cophh_delete_pvs(b, "foo_3", 0);
-	b = cophh_delete_pvs(b, "foo_5", 0);
-	check_iv(cophh_fetch_pvs(b, "foo_1", 0), 1111);
-	check_iv(cophh_fetch_pvs(b, "foo_2", 0), 222);
-	check_ph(cophh_fetch_pvs(b, "foo_3", 0));
-	check_ph(cophh_fetch_pvs(b, "foo_4", 0));
-	check_ph(cophh_fetch_pvs(b, "foo_5", 0));
-	cophh_free(b);
-	check_ph(cophh_fetch_pvs(a, "foo_1", 0));
-	check_ph(cophh_fetch_pvs(a, "foo_2", 0));
-	check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
-	check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
-	check_ph(cophh_fetch_pvs(a, "foo_5", 0));
-	a = cophh_store_pvs(a, "foo_1", msviv(11111), COPHH_KEY_UTF8);
-	a = cophh_store_pvs(a, "foo_\xaa", msviv(123), 0);
-	a = cophh_store_pvs(a, "foo_\xc2\xbb", msviv(456), COPHH_KEY_UTF8);
-	a = cophh_store_pvs(a, "foo_\xc3\x8c", msviv(789), COPHH_KEY_UTF8);
-	a = cophh_store_pvs(a, "foo_\xd9\xa6", msviv(666), COPHH_KEY_UTF8);
-	check_iv(cophh_fetch_pvs(a, "foo_1", 0), 11111);
-	check_iv(cophh_fetch_pvs(a, "foo_1", COPHH_KEY_UTF8), 11111);
-	check_iv(cophh_fetch_pvs(a, "foo_\xaa", 0), 123);
-	check_iv(cophh_fetch_pvs(a, "foo_\xc2\xaa", COPHH_KEY_UTF8), 123);
-	check_ph(cophh_fetch_pvs(a, "foo_\xc2\xaa", 0));
-	check_iv(cophh_fetch_pvs(a, "foo_\xbb", 0), 456);
-	check_iv(cophh_fetch_pvs(a, "foo_\xc2\xbb", COPHH_KEY_UTF8), 456);
-	check_ph(cophh_fetch_pvs(a, "foo_\xc2\xbb", 0));
-	check_iv(cophh_fetch_pvs(a, "foo_\xcc", 0), 789);
-	check_iv(cophh_fetch_pvs(a, "foo_\xc3\x8c", COPHH_KEY_UTF8), 789);
-	check_ph(cophh_fetch_pvs(a, "foo_\xc2\x8c", 0));
-	check_iv(cophh_fetch_pvs(a, "foo_\xd9\xa6", COPHH_KEY_UTF8), 666);
-	check_ph(cophh_fetch_pvs(a, "foo_\xd9\xa6", 0));
-	ENTER;
-	SAVEFREECOPHH(a);
-	LEAVE;
-#undef check_ph
-#undef check_iv
-#undef msvpvs
-#undef msviv
-
-void
-test_coplabel()
-    PREINIT:
-        COP *cop;
-        const char *label;
-        STRLEN len;
-        U32 utf8;
-    CODE:
-        cop = &PL_compiling;
-        Perl_cop_store_label(aTHX_ cop, "foo", 3, 0);
-        label = Perl_cop_fetch_label(aTHX_ cop, &len, &utf8);
-        if (strcmp(label,"foo")) croak("fail # cop_fetch_label label");
-        if (len != 3) croak("fail # cop_fetch_label len");
-        if (utf8) croak("fail # cop_fetch_label utf8");
-        /* SMALL GERMAN UMLAUT A */
-        Perl_cop_store_label(aTHX_ cop, "fo\xc3\xa4", 4, SVf_UTF8);
-        label = Perl_cop_fetch_label(aTHX_ cop, &len, &utf8);
-        if (strcmp(label,"fo\xc3\xa4")) croak("fail # cop_fetch_label label");
-        if (len != 4) croak("fail # cop_fetch_label len");
-        if (!utf8) croak("fail # cop_fetch_label utf8");
-
-
-HV *
-example_cophh_2hv()
-    PREINIT:
-	COPHH *a;
-    CODE:
-#define msviv(VALUE) sv_2mortal(newSViv(VALUE))
-	a = cophh_new_empty();
-	a = cophh_store_pvs(a, "foo_0", msviv(999), 0);
-	a = cophh_store_pvs(a, "foo_1", msviv(111), 0);
-	a = cophh_store_pvs(a, "foo_\xaa", msviv(123), 0);
-	a = cophh_store_pvs(a, "foo_\xc2\xbb", msviv(456), COPHH_KEY_UTF8);
-	a = cophh_store_pvs(a, "foo_\xc3\x8c", msviv(789), COPHH_KEY_UTF8);
-	a = cophh_store_pvs(a, "foo_\xd9\xa6", msviv(666), COPHH_KEY_UTF8);
-	a = cophh_delete_pvs(a, "foo_0", 0);
-	a = cophh_delete_pvs(a, "foo_2", 0);
-	RETVAL = cophh_2hv(a, 0);
-	cophh_free(a);
-#undef msviv
-    OUTPUT:
-	RETVAL
-
-void
-test_savehints()
-    PREINIT:
-	SV **svp, *sv;
-    CODE:
-#define store_hint(KEY, VALUE) \
-		sv_setiv_mg(*hv_fetchs(GvHV(PL_hintgv), KEY, 1), (VALUE))
-#define hint_ok(KEY, EXPECT) \
-		((svp = hv_fetchs(GvHV(PL_hintgv), KEY, 0)) && \
-		    (sv = *svp) && SvIV(sv) == (EXPECT) && \
-		    (sv = cop_hints_fetch_pvs(&PL_compiling, KEY, 0)) && \
-		    SvIV(sv) == (EXPECT))
-#define check_hint(KEY, EXPECT) \
-		do { if (!hint_ok(KEY, EXPECT)) croak_fail(); } while(0)
-	PL_hints |= HINT_LOCALIZE_HH;
-	ENTER;
-	SAVEHINTS();
-	PL_hints &= HINT_INTEGER;
-	store_hint("t0", 123);
-	store_hint("t1", 456);
-	if (PL_hints & HINT_INTEGER) croak_fail();
-	check_hint("t0", 123); check_hint("t1", 456);
-	ENTER;
-	SAVEHINTS();
-	if (PL_hints & HINT_INTEGER) croak_fail();
-	check_hint("t0", 123); check_hint("t1", 456);
-	PL_hints |= HINT_INTEGER;
-	store_hint("t0", 321);
-	if (!(PL_hints & HINT_INTEGER)) croak_fail();
-	check_hint("t0", 321); check_hint("t1", 456);
-	LEAVE;
-	if (PL_hints & HINT_INTEGER) croak_fail();
-	check_hint("t0", 123); check_hint("t1", 456);
-	ENTER;
-	SAVEHINTS();
-	if (PL_hints & HINT_INTEGER) croak_fail();
-	check_hint("t0", 123); check_hint("t1", 456);
-	store_hint("t1", 654);
-	if (PL_hints & HINT_INTEGER) croak_fail();
-	check_hint("t0", 123); check_hint("t1", 654);
-	LEAVE;
-	if (PL_hints & HINT_INTEGER) croak_fail();
-	check_hint("t0", 123); check_hint("t1", 456);
-	LEAVE;
-#undef store_hint
-#undef hint_ok
-#undef check_hint
-
-void
-test_copyhints()
-    PREINIT:
-	HV *a, *b;
-    CODE:
-	PL_hints |= HINT_LOCALIZE_HH;
-	ENTER;
-	SAVEHINTS();
-	sv_setiv_mg(*hv_fetchs(GvHV(PL_hintgv), "t0", 1), 123);
-	if (SvIV(cop_hints_fetch_pvs(&PL_compiling, "t0", 0)) != 123)
-	    croak_fail();
-	a = newHVhv(GvHV(PL_hintgv));
-	sv_2mortal((SV*)a);
-	sv_setiv_mg(*hv_fetchs(a, "t0", 1), 456);
-	if (SvIV(cop_hints_fetch_pvs(&PL_compiling, "t0", 0)) != 123)
-	    croak_fail();
-	b = hv_copy_hints_hv(a);
-	sv_2mortal((SV*)b);
-	sv_setiv_mg(*hv_fetchs(b, "t0", 1), 789);
-	if (SvIV(cop_hints_fetch_pvs(&PL_compiling, "t0", 0)) != 789)
-	    croak_fail();
-	LEAVE;
-
-void
-test_op_list()
-    PREINIT:
-	OP *a;
-    CODE:
-#define iv_op(iv) newSVOP(OP_CONST, 0, newSViv(iv))
-#define check_op(o, expect) \
-    do { \
-	if (strcmp(test_op_list_describe(o), (expect))) \
-	    croak("fail %s %s", test_op_list_describe(o), (expect)); \
-    } while(0)
-	a = op_append_elem(OP_LIST, NULL, NULL);
-	check_op(a, "");
-	a = op_append_elem(OP_LIST, iv_op(1), a);
-	check_op(a, "const(1).");
-	a = op_append_elem(OP_LIST, NULL, a);
-	check_op(a, "const(1).");
-	a = op_append_elem(OP_LIST, a, iv_op(2));
-	check_op(a, "list[pushmark.const(1).const(2).]");
-	a = op_append_elem(OP_LIST, a, iv_op(3));
-	check_op(a, "list[pushmark.const(1).const(2).const(3).]");
-	a = op_append_elem(OP_LIST, a, NULL);
-	check_op(a, "list[pushmark.const(1).const(2).const(3).]");
-	a = op_append_elem(OP_LIST, NULL, a);
-	check_op(a, "list[pushmark.const(1).const(2).const(3).]");
-	a = op_append_elem(OP_LIST, iv_op(4), a);
-	check_op(a, "list[pushmark.const(4)."
-		"list[pushmark.const(1).const(2).const(3).]]");
-	a = op_append_elem(OP_LIST, a, iv_op(5));
-	check_op(a, "list[pushmark.const(4)."
-		"list[pushmark.const(1).const(2).const(3).]const(5).]");
-	a = op_append_elem(OP_LIST, a, 
-		op_append_elem(OP_LIST, iv_op(7), iv_op(6)));
-	check_op(a, "list[pushmark.const(4)."
-		"list[pushmark.const(1).const(2).const(3).]const(5)."
-		"list[pushmark.const(7).const(6).]]");
-	op_free(a);
-	a = op_append_elem(OP_LINESEQ, iv_op(1), iv_op(2));
-	check_op(a, "lineseq[const(1).const(2).]");
-	a = op_append_elem(OP_LINESEQ, a, iv_op(3));
-	check_op(a, "lineseq[const(1).const(2).const(3).]");
-	op_free(a);
-	a = op_append_elem(OP_LINESEQ,
-		op_append_elem(OP_LIST, iv_op(1), iv_op(2)),
-		iv_op(3));
-	check_op(a, "lineseq[list[pushmark.const(1).const(2).]const(3).]");
-	op_free(a);
-	a = op_prepend_elem(OP_LIST, NULL, NULL);
-	check_op(a, "");
-	a = op_prepend_elem(OP_LIST, a, iv_op(1));
-	check_op(a, "const(1).");
-	a = op_prepend_elem(OP_LIST, a, NULL);
-	check_op(a, "const(1).");
-	a = op_prepend_elem(OP_LIST, iv_op(2), a);
-	check_op(a, "list[pushmark.const(2).const(1).]");
-	a = op_prepend_elem(OP_LIST, iv_op(3), a);
-	check_op(a, "list[pushmark.const(3).const(2).const(1).]");
-	a = op_prepend_elem(OP_LIST, NULL, a);
-	check_op(a, "list[pushmark.const(3).const(2).const(1).]");
-	a = op_prepend_elem(OP_LIST, a, NULL);
-	check_op(a, "list[pushmark.const(3).const(2).const(1).]");
-	a = op_prepend_elem(OP_LIST, a, iv_op(4));
-	check_op(a, "list[pushmark."
-		"list[pushmark.const(3).const(2).const(1).]const(4).]");
-	a = op_prepend_elem(OP_LIST, iv_op(5), a);
-	check_op(a, "list[pushmark.const(5)."
-		"list[pushmark.const(3).const(2).const(1).]const(4).]");
-	a = op_prepend_elem(OP_LIST,
-		op_prepend_elem(OP_LIST, iv_op(6), iv_op(7)), a);
-	check_op(a, "list[pushmark.list[pushmark.const(6).const(7).]const(5)."
-		"list[pushmark.const(3).const(2).const(1).]const(4).]");
-	op_free(a);
-	a = op_prepend_elem(OP_LINESEQ, iv_op(2), iv_op(1));
-	check_op(a, "lineseq[const(2).const(1).]");
-	a = op_prepend_elem(OP_LINESEQ, iv_op(3), a);
-	check_op(a, "lineseq[const(3).const(2).const(1).]");
-	op_free(a);
-	a = op_prepend_elem(OP_LINESEQ, iv_op(3),
-		op_prepend_elem(OP_LIST, iv_op(2), iv_op(1)));
-	check_op(a, "lineseq[const(3).list[pushmark.const(2).const(1).]]");
-	op_free(a);
-	a = op_append_list(OP_LINESEQ, NULL, NULL);
-	check_op(a, "");
-	a = op_append_list(OP_LINESEQ, iv_op(1), a);
-	check_op(a, "const(1).");
-	a = op_append_list(OP_LINESEQ, NULL, a);
-	check_op(a, "const(1).");
-	a = op_append_list(OP_LINESEQ, a, iv_op(2));
-	check_op(a, "lineseq[const(1).const(2).]");
-	a = op_append_list(OP_LINESEQ, a, iv_op(3));
-	check_op(a, "lineseq[const(1).const(2).const(3).]");
-	a = op_append_list(OP_LINESEQ, iv_op(4), a);
-	check_op(a, "lineseq[const(4).const(1).const(2).const(3).]");
-	a = op_append_list(OP_LINESEQ, a, NULL);
-	check_op(a, "lineseq[const(4).const(1).const(2).const(3).]");
-	a = op_append_list(OP_LINESEQ, NULL, a);
-	check_op(a, "lineseq[const(4).const(1).const(2).const(3).]");
-	a = op_append_list(OP_LINESEQ, a,
-		op_append_list(OP_LINESEQ, iv_op(5), iv_op(6)));
-	check_op(a, "lineseq[const(4).const(1).const(2).const(3)."
-		"const(5).const(6).]");
-	op_free(a);
-	a = op_append_list(OP_LINESEQ,
-		op_append_list(OP_LINESEQ, iv_op(1), iv_op(2)),
-		op_append_list(OP_LIST, iv_op(3), iv_op(4)));
-	check_op(a, "lineseq[const(1).const(2)."
-		"list[pushmark.const(3).const(4).]]");
-	op_free(a);
-	a = op_append_list(OP_LINESEQ,
-		op_append_list(OP_LIST, iv_op(1), iv_op(2)),
-		op_append_list(OP_LINESEQ, iv_op(3), iv_op(4)));
-	check_op(a, "lineseq[list[pushmark.const(1).const(2).]"
-		"const(3).const(4).]");
-	op_free(a);
-#undef check_op
-
-void
-test_op_linklist ()
-    PREINIT:
-        OP *o;
-    CODE:
-#define check_ll(o, expect) \
-    STMT_START { \
-	if (strNE(test_op_linklist_describe(o), (expect))) \
-	    croak("fail %s %s", test_op_linklist_describe(o), (expect)); \
-    } STMT_END
-        o = iv_op(1);
-        check_ll(o, ".const1");
-        op_free(o);
-
-        o = mkUNOP(OP_NOT, iv_op(1));
-        check_ll(o, ".const1.not");
-        op_free(o);
-
-        o = mkUNOP(OP_NOT, mkUNOP(OP_NEGATE, iv_op(1)));
-        check_ll(o, ".const1.negate.not");
-        op_free(o);
-
-        o = mkBINOP(OP_ADD, iv_op(1), iv_op(2));
-        check_ll(o, ".const1.const2.add");
-        op_free(o);
-
-        o = mkBINOP(OP_ADD, mkUNOP(OP_NOT, iv_op(1)), iv_op(2));
-        check_ll(o, ".const1.not.const2.add");
-        op_free(o);
-
-        o = mkUNOP(OP_NOT, mkBINOP(OP_ADD, iv_op(1), iv_op(2)));
-        check_ll(o, ".const1.const2.add.not");
-        op_free(o);
-
-        o = mkLISTOP(OP_LINESEQ, iv_op(1), iv_op(2), iv_op(3));
-        check_ll(o, ".const1.const2.const3.lineseq");
-        op_free(o);
-
-        o = mkLISTOP(OP_LINESEQ,
-                mkBINOP(OP_ADD, iv_op(1), iv_op(2)),
-                mkUNOP(OP_NOT, iv_op(3)),
-                mkLISTOP(OP_SUBSTR, iv_op(4), iv_op(5), iv_op(6)));
-        check_ll(o, ".const1.const2.add.const3.not"
-                    ".const4.const5.const6.substr.lineseq");
-        op_free(o);
-
-        o = mkBINOP(OP_ADD, iv_op(1), iv_op(2));
-        LINKLIST(o);
-        o = mkBINOP(OP_SUBTRACT, o, iv_op(3));
-        check_ll(o, ".const1.const2.add.const3.subtract");
-        op_free(o);
-#undef check_ll
-#undef iv_op
-
-void
-peep_enable ()
-    PREINIT:
-	dMY_CXT;
-    CODE:
-	av_clear(MY_CXT.peep_recorder);
-	av_clear(MY_CXT.rpeep_recorder);
-	MY_CXT.peep_recording = 1;
-
-void
-peep_disable ()
-    PREINIT:
-	dMY_CXT;
-    CODE:
-	MY_CXT.peep_recording = 0;
-
-SV *
-peep_record ()
-    PREINIT:
-	dMY_CXT;
-    CODE:
-	RETVAL = newRV_inc((SV *)MY_CXT.peep_recorder);
-    OUTPUT:
-	RETVAL
-
-SV *
-rpeep_record ()
-    PREINIT:
-	dMY_CXT;
-    CODE:
-	RETVAL = newRV_inc((SV *)MY_CXT.rpeep_recorder);
-    OUTPUT:
-	RETVAL
-
-=pod
-
-multicall_each: call a sub for each item in the list. Used to test MULTICALL
-
-=cut
-
-void
-multicall_each(block,...)
-    SV * block
-PROTOTYPE: &@
-CODE:
-{
-    dMULTICALL;
-    int index;
-    GV *gv;
-    HV *stash;
-    I32 gimme = G_SCALAR;
-    SV **args = &PL_stack_base[ax];
-    CV *cv;
-
-    if(items <= 1) {
-	XSRETURN_UNDEF;
-    }
-    cv = sv_2cv(block, &stash, &gv, 0);
-    if (cv == Nullcv) {
-       croak("multicall_each: not a subroutine reference");
-    }
-    PUSH_MULTICALL(cv);
-    SAVESPTR(GvSV(PL_defgv));
-
-    for(index = 1 ; index < items ; index++) {
-	GvSV(PL_defgv) = args[index];
-	MULTICALL;
-    }
-    POP_MULTICALL;
-    PERL_UNUSED_VAR(newsp);
-    XSRETURN_UNDEF;
-}
-
-#ifdef USE_ITHREADS
-
-void
-clone_with_stack()
-CODE:
-{
-    PerlInterpreter *interp = aTHX; /* The original interpreter */
-    PerlInterpreter *interp_dup;    /* The duplicate interpreter */
-    int oldscope = 1; /* We are responsible for all scopes */
-
-    interp_dup = perl_clone(interp, CLONEf_COPY_STACKS | CLONEf_CLONE_HOST );
-
-    /* destroy old perl */
-    PERL_SET_CONTEXT(interp);
-
-    POPSTACK_TO(PL_mainstack);
-    dounwind(-1);
-    LEAVE_SCOPE(0);
-
-    while (interp->Iscopestack_ix > 1)
-        LEAVE;
-    FREETMPS;
-
-    perl_destruct(interp);
-    perl_free(interp);
-
-    /* switch to new perl */
-    PERL_SET_CONTEXT(interp_dup);
-
-    /* continue after 'clone_with_stack' */
-    if (interp_dup->Iop)
-	interp_dup->Iop = interp_dup->Iop->op_next;
-
-    /* run with new perl */
-    Perl_runops_standard(interp_dup);
-
-    /* We may have additional unclosed scopes if fork() was called
-     * from within a BEGIN block.  See perlfork.pod for more details.
-     * We cannot clean up these other scopes because they belong to a
-     * different interpreter, but we also cannot leave PL_scopestack_ix
-     * dangling because that can trigger an assertion in perl_destruct().
-     */
-    if (PL_scopestack_ix > oldscope) {
-        PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
-        PL_scopestack_ix = oldscope;
-    }
-
-    perl_destruct(interp_dup);
-    perl_free(interp_dup);
-
-    /* call the real 'exit' not PerlProc_exit */
-#undef exit
-    exit(0);
-}
-
-#endif /* USE_ITHREDS */
-
-SV*
-take_svref(SVREF sv)
-CODE:
-    RETVAL = newRV_inc(sv);
-OUTPUT:
-    RETVAL
-
-SV*
-take_avref(AV* av)
-CODE:
-    RETVAL = newRV_inc((SV*)av);
-OUTPUT:
-    RETVAL
-
-SV*
-take_hvref(HV* hv)
-CODE:
-    RETVAL = newRV_inc((SV*)hv);
-OUTPUT:
-    RETVAL
-
-
-SV*
-take_cvref(CV* cv)
-CODE:
-    RETVAL = newRV_inc((SV*)cv);
-OUTPUT:
-    RETVAL
-
-
-BOOT:
-	{
-	HV* stash;
-	SV** meth = NULL;
-	CV* cv;
-	stash = gv_stashpv("XS::APItest::TempLv", 0);
-	if (stash)
-	    meth = hv_fetchs(stash, "make_temp_mg_lv", 0);
-	if (!meth)
-	    croak("lost method 'make_temp_mg_lv'");
-	cv = GvCV(*meth);
-	CvLVALUE_on(cv);
-	}
-
-BOOT:
-{
-    hintkey_rpn_sv = newSVpvs_share("XS::APItest/rpn");
-    hintkey_calcrpn_sv = newSVpvs_share("XS::APItest/calcrpn");
-    hintkey_stufftest_sv = newSVpvs_share("XS::APItest/stufftest");
-    hintkey_swaptwostmts_sv = newSVpvs_share("XS::APItest/swaptwostmts");
-    hintkey_looprest_sv = newSVpvs_share("XS::APItest/looprest");
-    hintkey_scopelessblock_sv = newSVpvs_share("XS::APItest/scopelessblock");
-    hintkey_stmtasexpr_sv = newSVpvs_share("XS::APItest/stmtasexpr");
-    hintkey_stmtsasexpr_sv = newSVpvs_share("XS::APItest/stmtsasexpr");
-    hintkey_loopblock_sv = newSVpvs_share("XS::APItest/loopblock");
-    hintkey_blockasexpr_sv = newSVpvs_share("XS::APItest/blockasexpr");
-    hintkey_swaplabel_sv = newSVpvs_share("XS::APItest/swaplabel");
-    hintkey_labelconst_sv = newSVpvs_share("XS::APItest/labelconst");
-    hintkey_arrayfullexpr_sv = newSVpvs_share("XS::APItest/arrayfullexpr");
-    hintkey_arraylistexpr_sv = newSVpvs_share("XS::APItest/arraylistexpr");
-    hintkey_arraytermexpr_sv = newSVpvs_share("XS::APItest/arraytermexpr");
-    hintkey_arrayarithexpr_sv = newSVpvs_share("XS::APItest/arrayarithexpr");
-    hintkey_arrayexprflags_sv = newSVpvs_share("XS::APItest/arrayexprflags");
-    next_keyword_plugin = PL_keyword_plugin;
-    PL_keyword_plugin = my_keyword_plugin;
-}
-
-void
-establish_cleanup(...)
-PROTOTYPE: $
-CODE:
-    PERL_UNUSED_VAR(items);
-    croak("establish_cleanup called as a function");
-
-BOOT:
-{
-    CV *estcv = get_cv("XS::APItest::establish_cleanup", 0);
-    cv_set_call_checker(estcv, THX_ck_entersub_establish_cleanup, (SV*)estcv);
-}
-
-void
-postinc(...)
-PROTOTYPE: $
-CODE:
-    PERL_UNUSED_VAR(items);
-    croak("postinc called as a function");
-
-void
-filter()
-CODE:
-    filter_add(filter_call, NULL);
-
-BOOT:
-{
-    CV *asscv = get_cv("XS::APItest::postinc", 0);
-    cv_set_call_checker(asscv, THX_ck_entersub_postinc, (SV*)asscv);
-}
-
-SV *
-lv_temp_object()
-CODE:
-    RETVAL =
-	  sv_bless(
-	    newRV_noinc(newSV(0)),
-	    gv_stashpvs("XS::APItest::TempObj",GV_ADD)
-	  );             /* Package defined in test script */
-OUTPUT:
-    RETVAL
-
-void
-fill_hash_with_nulls(HV *hv)
-PREINIT:
-    UV i = 0;
-CODE:
-    for(; i < 1000; ++i) {
-	HE *entry = hv_fetch_ent(hv, sv_2mortal(newSVuv(i)), 1, 0);
-	SvREFCNT_dec(HeVAL(entry));
-	HeVAL(entry) = NULL;
-    }
-
-HV *
-newHVhv(HV *hv)
-CODE:
-    RETVAL = newHVhv(hv);
-OUTPUT:
-    RETVAL
-
-U32
-SvIsCOW(SV *sv)
-CODE:
-    RETVAL = SvIsCOW(sv);
-OUTPUT:
-    RETVAL
-
-void
-pad_scalar(...)
-PROTOTYPE: $$
-CODE:
-    PERL_UNUSED_VAR(items);
-    croak("pad_scalar called as a function");
-
-BOOT:
-{
-    CV *pscv = get_cv("XS::APItest::pad_scalar", 0);
-    cv_set_call_checker(pscv, THX_ck_entersub_pad_scalar, (SV*)pscv);
-}
-
-SV*
-fetch_pad_names( cv )
-CV* cv
- PREINIT:
-  I32 i;
-  PADNAMELIST *pad_namelist;
-  AV *retav = newAV();
- CODE:
-  pad_namelist = PadlistNAMES(CvPADLIST(cv));
-
-  for ( i = PadnamelistMAX(pad_namelist); i >= 0; i-- ) {
-    PADNAME* name = PadnamelistARRAY(pad_namelist)[i];
-
-    if (PadnameLEN(name)) {
-        av_push(retav, newSVpadname(name));
-    }
-  }
-  RETVAL = newRV_noinc((SV*)retav);
- OUTPUT:
-  RETVAL
-
-STRLEN
-underscore_length()
-PROTOTYPE:
-PREINIT:
-    SV *u;
-    U8 *pv;
-    STRLEN bytelen;
-CODE:
-    u = find_rundefsv();
-    pv = (U8*)SvPV(u, bytelen);
-    RETVAL = SvUTF8(u) ? utf8_length(pv, pv+bytelen) : bytelen;
-OUTPUT:
-    RETVAL
-
-void
-stringify(SV *sv)
-CODE:
-    (void)SvPV_nolen(sv);
-
-SV *
-HvENAME(HV *hv)
-CODE:
-    RETVAL = hv && HvENAME(hv)
-	      ? newSVpvn_flags(
-		  HvENAME(hv),HvENAMELEN(hv),
-		  (HvENAMEUTF8(hv) ? SVf_UTF8 : 0)
-		)
-	      : NULL;
-OUTPUT:
-    RETVAL
-
-int
-xs_cmp(int a, int b)
-CODE:
-    /* Odd sorting (odd numbers first), to make sure we are actually
-       being called */
-    RETVAL = a % 2 != b % 2
-	       ? a % 2 ? -1 : 1
-	       : a < b ? -1 : a == b ? 0 : 1;
-OUTPUT:
-    RETVAL
-
-SV *
-xs_cmp_undef(SV *a, SV *b)
-CODE:
-    PERL_UNUSED_ARG(a);
-    PERL_UNUSED_ARG(b);
-    RETVAL = &PL_sv_undef;
-OUTPUT:
-    RETVAL
-
-char *
-SvPVbyte(SV *sv)
-CODE:
-    RETVAL = SvPVbyte_nolen(sv);
-OUTPUT:
-    RETVAL
-
-char *
-SvPVutf8(SV *sv)
-CODE:
-    RETVAL = SvPVutf8_nolen(sv);
-OUTPUT:
-    RETVAL
-
-void
-setup_addissub()
-CODE:
-    wrap_op_checker(OP_ADD, addissub_myck_add, &addissub_nxck_add);
-
-void
-setup_rv2cv_addunderbar()
-CODE:
-    wrap_op_checker(OP_RV2CV, my_ck_rv2cv, &old_ck_rv2cv);
-
-#ifdef USE_ITHREADS
-
-bool
-test_alloccopstash()
-CODE:
-    RETVAL = PL_stashpad[alloccopstash(PL_defstash)] == PL_defstash;
-OUTPUT:
-    RETVAL
-
-#endif
-
-bool
-test_newFOROP_without_slab()
-CODE:
-    {
-	const I32 floor = start_subparse(0,0);
-	/* The slab allocator does not like CvROOT being set. */
-	CvROOT(PL_compcv) = (OP *)1;
-	op_free(newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0));
-	CvROOT(PL_compcv) = NULL;
-	SvREFCNT_dec(PL_compcv);
-	LEAVE_SCOPE(floor);
-	/* If we have not crashed yet, then the test passes. */
-	RETVAL = TRUE;
-    }
-OUTPUT:
-    RETVAL
-
- # provide access to CALLREGEXEC, except replace pointers within the
- # string with offsets from the start of the string
-
-I32
-callregexec(SV *prog, STRLEN stringarg, STRLEN strend, I32 minend, SV *sv, U32 nosave)
-CODE:
-    {
-	STRLEN len;
-	char *strbeg;
-	if (SvROK(prog))
-	    prog = SvRV(prog);
-	strbeg = SvPV_force(sv, len);
-	RETVAL = CALLREGEXEC((REGEXP *)prog,
-			    strbeg + stringarg,
-			    strbeg + strend,
-			    strbeg,
-			    minend,
-			    sv,
-			    NULL, /* data */
-			    nosave);
-    }
-OUTPUT:
-    RETVAL
-
-void
-lexical_import(SV *name, CV *cv)
-    CODE:
-    {
-	PADLIST *pl;
-	PADOFFSET off;
-	if (!PL_compcv)
-	    Perl_croak(aTHX_
-		      "lexical_import can only be called at compile time");
-	pl = CvPADLIST(PL_compcv);
-	ENTER;
-	SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(pl);
-	SAVESPTR(PL_comppad);	   PL_comppad	   = PadlistARRAY(pl)[1];
-	SAVESPTR(PL_curpad);	   PL_curpad	   = PadARRAY(PL_comppad);
-	off = pad_add_name_sv(sv_2mortal(newSVpvf("&%"SVf,name)),
-			      padadd_STATE, 0, 0);
-	SvREFCNT_dec(PL_curpad[off]);
-	PL_curpad[off] = SvREFCNT_inc(cv);
-	LEAVE;
-    }
-
-SV *
-sv_mortalcopy(SV *sv)
-    CODE:
-	RETVAL = SvREFCNT_inc(sv_mortalcopy(sv));
-    OUTPUT:
-	RETVAL
-
-SV *
-newRV(SV *sv)
-
-void
-alias_av(AV *av, IV ix, SV *sv)
-    CODE:
-	av_store(av, ix, SvREFCNT_inc(sv));
-
-MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
-
-int
-AUTOLOAD(...)
-  INIT:
-    SV* comms;
-    SV* class_and_method;
-  CODE:
-    PERL_UNUSED_ARG(items);
-    class_and_method = GvSV(CvGV(cv));
-    comms = get_sv("main::the_method", 1);
-    if (class_and_method == NULL) {
-      RETVAL = 1;
-    } else if (!SvOK(class_and_method)) {
-      RETVAL = 2;
-    } else if (!SvPOK(class_and_method)) {
-      RETVAL = 3;
-    } else {
-      sv_setsv(comms, class_and_method);
-      RETVAL = 0;
-    }
-  OUTPUT: RETVAL
-
-
-MODULE = XS::APItest		PACKAGE = XS::APItest::Magic
-
-PROTOTYPES: DISABLE
-
-void
-sv_magic_foo(SV *sv, SV *thingy)
-ALIAS:
-    sv_magic_bar = 1
-CODE:
-    sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo, (const char *)thingy, 0);
-
-SV *
-mg_find_foo(SV *sv)
-ALIAS:
-    mg_find_bar = 1
-CODE:
-    MAGIC *mg = mg_findext(SvRV(sv), PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo);
-    RETVAL = mg ? SvREFCNT_inc((SV *)mg->mg_ptr) : &PL_sv_undef;
-OUTPUT:
-    RETVAL
-
-void
-sv_unmagic_foo(SV *sv)
-ALIAS:
-    sv_unmagic_bar = 1
-CODE:
-    sv_unmagicext(SvRV(sv), PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo);
-
-UV
-test_get_vtbl()
-    PREINIT:
-	MGVTBL *have;
-	MGVTBL *want;
-    CODE:
-#define test_get_this_vtable(name) \
-	want = (MGVTBL*)CAT2(&PL_vtbl_, name); \
-	have = get_vtbl(CAT2(want_vtbl_, name)); \
-	if (have != want) \
-	    croak("fail %p!=%p for get_vtbl(want_vtbl_" STRINGIFY(name) ") at " __FILE__ " line %d", have, want, __LINE__)
-
-	test_get_this_vtable(sv);
-	test_get_this_vtable(env);
-	test_get_this_vtable(envelem);
-	test_get_this_vtable(sigelem);
-	test_get_this_vtable(pack);
-	test_get_this_vtable(packelem);
-	test_get_this_vtable(dbline);
-	test_get_this_vtable(isa);
-	test_get_this_vtable(isaelem);
-	test_get_this_vtable(arylen);
-	test_get_this_vtable(mglob);
-	test_get_this_vtable(nkeys);
-	test_get_this_vtable(taint);
-	test_get_this_vtable(substr);
-	test_get_this_vtable(vec);
-	test_get_this_vtable(pos);
-	test_get_this_vtable(bm);
-	test_get_this_vtable(fm);
-	test_get_this_vtable(uvar);
-	test_get_this_vtable(defelem);
-	test_get_this_vtable(regexp);
-	test_get_this_vtable(regdata);
-	test_get_this_vtable(regdatum);
-#ifdef USE_LOCALE_COLLATE
-	test_get_this_vtable(collxfrm);
-#endif
-	test_get_this_vtable(backref);
-	test_get_this_vtable(utf8);
-
-	RETVAL = PTR2UV(get_vtbl(-1));
-    OUTPUT:
-	RETVAL
-
-bool
-test_isBLANK_uni(UV ord)
-    CODE:
-        RETVAL = isBLANK_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isBLANK_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isBLANK_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isBLANK_A(UV ord)
-    CODE:
-        RETVAL = isBLANK_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isBLANK_L1(UV ord)
-    CODE:
-        RETVAL = isBLANK_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isBLANK_LC(UV ord)
-    CODE:
-        RETVAL = isBLANK_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isBLANK_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isBLANK_utf8(p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isBLANK_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isBLANK_LC_utf8(p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isVERTWS_uni(UV ord)
-    CODE:
-        RETVAL = isVERTWS_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isVERTWS_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isVERTWS_utf8(p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isUPPER_uni(UV ord)
-    CODE:
-        RETVAL = isUPPER_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isUPPER_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isUPPER_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isUPPER_A(UV ord)
-    CODE:
-        RETVAL = isUPPER_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isUPPER_L1(UV ord)
-    CODE:
-        RETVAL = isUPPER_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isUPPER_LC(UV ord)
-    CODE:
-        RETVAL = isUPPER_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isUPPER_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isUPPER_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isUPPER_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isUPPER_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isLOWER_uni(UV ord)
-    CODE:
-        RETVAL = isLOWER_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isLOWER_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isLOWER_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isLOWER_A(UV ord)
-    CODE:
-        RETVAL = isLOWER_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isLOWER_L1(UV ord)
-    CODE:
-        RETVAL = isLOWER_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isLOWER_LC(UV ord)
-    CODE:
-        RETVAL = isLOWER_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isLOWER_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isLOWER_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isLOWER_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isLOWER_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHA_uni(UV ord)
-    CODE:
-        RETVAL = isALPHA_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHA_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isALPHA_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHA_A(UV ord)
-    CODE:
-        RETVAL = isALPHA_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHA_L1(UV ord)
-    CODE:
-        RETVAL = isALPHA_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHA_LC(UV ord)
-    CODE:
-        RETVAL = isALPHA_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHA_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isALPHA_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHA_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isALPHA_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isWORDCHAR_uni(UV ord)
-    CODE:
-        RETVAL = isWORDCHAR_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isWORDCHAR_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isWORDCHAR_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isWORDCHAR_A(UV ord)
-    CODE:
-        RETVAL = isWORDCHAR_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isWORDCHAR_L1(UV ord)
-    CODE:
-        RETVAL = isWORDCHAR_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isWORDCHAR_LC(UV ord)
-    CODE:
-        RETVAL = isWORDCHAR_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isWORDCHAR_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isWORDCHAR_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isWORDCHAR_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isWORDCHAR_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHANUMERIC_uni(UV ord)
-    CODE:
-        RETVAL = isALPHANUMERIC_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHANUMERIC_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isALPHANUMERIC_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHANUMERIC_A(UV ord)
-    CODE:
-        RETVAL = isALPHANUMERIC_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHANUMERIC_L1(UV ord)
-    CODE:
-        RETVAL = isALPHANUMERIC_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHANUMERIC_LC(UV ord)
-    CODE:
-        RETVAL = isALPHANUMERIC_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHANUMERIC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isALPHANUMERIC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALPHANUMERIC_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isALPHANUMERIC_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALNUM_uni(UV ord)
-    CODE:
-        RETVAL = isALNUM_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALNUM_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isALNUM_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALNUM_LC(UV ord)
-    CODE:
-        RETVAL = isALNUM_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALNUM_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isALNUM_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isALNUM_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isALNUM_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isDIGIT_uni(UV ord)
-    CODE:
-        RETVAL = isDIGIT_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isDIGIT_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isDIGIT_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isDIGIT_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isDIGIT_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isDIGIT_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isDIGIT_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isDIGIT_A(UV ord)
-    CODE:
-        RETVAL = isDIGIT_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isDIGIT_L1(UV ord)
-    CODE:
-        RETVAL = isDIGIT_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isDIGIT_LC(UV ord)
-    CODE:
-        RETVAL = isDIGIT_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDFIRST_uni(UV ord)
-    CODE:
-        RETVAL = isIDFIRST_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDFIRST_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isIDFIRST_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDFIRST_A(UV ord)
-    CODE:
-        RETVAL = isIDFIRST_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDFIRST_L1(UV ord)
-    CODE:
-        RETVAL = isIDFIRST_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDFIRST_LC(UV ord)
-    CODE:
-        RETVAL = isIDFIRST_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDFIRST_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isIDFIRST_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDFIRST_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isIDFIRST_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDCONT_uni(UV ord)
-    CODE:
-        RETVAL = isIDCONT_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDCONT_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isIDCONT_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDCONT_A(UV ord)
-    CODE:
-        RETVAL = isIDCONT_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDCONT_L1(UV ord)
-    CODE:
-        RETVAL = isIDCONT_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDCONT_LC(UV ord)
-    CODE:
-        RETVAL = isIDCONT_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDCONT_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isIDCONT_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isIDCONT_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isIDCONT_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isSPACE_uni(UV ord)
-    CODE:
-        RETVAL = isSPACE_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isSPACE_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isSPACE_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isSPACE_A(UV ord)
-    CODE:
-        RETVAL = isSPACE_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isSPACE_L1(UV ord)
-    CODE:
-        RETVAL = isSPACE_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isSPACE_LC(UV ord)
-    CODE:
-        RETVAL = isSPACE_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isSPACE_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isSPACE_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isSPACE_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isSPACE_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isASCII_uni(UV ord)
-    CODE:
-        RETVAL = isASCII_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isASCII_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isASCII_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isASCII_A(UV ord)
-    CODE:
-        RETVAL = isASCII_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isASCII_L1(UV ord)
-    CODE:
-        RETVAL = isASCII_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isASCII_LC(UV ord)
-    CODE:
-        RETVAL = isASCII_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isASCII_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isASCII_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isASCII_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isASCII_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isCNTRL_uni(UV ord)
-    CODE:
-        RETVAL = isCNTRL_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isCNTRL_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isCNTRL_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isCNTRL_A(UV ord)
-    CODE:
-        RETVAL = isCNTRL_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isCNTRL_L1(UV ord)
-    CODE:
-        RETVAL = isCNTRL_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isCNTRL_LC(UV ord)
-    CODE:
-        RETVAL = isCNTRL_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isCNTRL_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isCNTRL_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isCNTRL_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isCNTRL_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPRINT_uni(UV ord)
-    CODE:
-        RETVAL = isPRINT_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPRINT_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isPRINT_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPRINT_A(UV ord)
-    CODE:
-        RETVAL = isPRINT_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPRINT_L1(UV ord)
-    CODE:
-        RETVAL = isPRINT_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPRINT_LC(UV ord)
-    CODE:
-        RETVAL = isPRINT_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPRINT_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isPRINT_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPRINT_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isPRINT_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isGRAPH_uni(UV ord)
-    CODE:
-        RETVAL = isGRAPH_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isGRAPH_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isGRAPH_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isGRAPH_A(UV ord)
-    CODE:
-        RETVAL = isGRAPH_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isGRAPH_L1(UV ord)
-    CODE:
-        RETVAL = isGRAPH_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isGRAPH_LC(UV ord)
-    CODE:
-        RETVAL = isGRAPH_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isGRAPH_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isGRAPH_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isGRAPH_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isGRAPH_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPUNCT_uni(UV ord)
-    CODE:
-        RETVAL = isPUNCT_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPUNCT_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isPUNCT_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPUNCT_A(UV ord)
-    CODE:
-        RETVAL = isPUNCT_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPUNCT_L1(UV ord)
-    CODE:
-        RETVAL = isPUNCT_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPUNCT_LC(UV ord)
-    CODE:
-        RETVAL = isPUNCT_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPUNCT_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isPUNCT_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPUNCT_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isPUNCT_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isXDIGIT_uni(UV ord)
-    CODE:
-        RETVAL = isXDIGIT_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isXDIGIT_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isXDIGIT_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isXDIGIT_A(UV ord)
-    CODE:
-        RETVAL = isXDIGIT_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isXDIGIT_L1(UV ord)
-    CODE:
-        RETVAL = isXDIGIT_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isXDIGIT_LC(UV ord)
-    CODE:
-        RETVAL = isXDIGIT_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isXDIGIT_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isXDIGIT_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isXDIGIT_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isXDIGIT_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPSXSPC_uni(UV ord)
-    CODE:
-        RETVAL = isPSXSPC_uni(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPSXSPC_LC_uvchr(UV ord)
-    CODE:
-        RETVAL = isPSXSPC_LC_uvchr(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPSXSPC_A(UV ord)
-    CODE:
-        RETVAL = isPSXSPC_A(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPSXSPC_L1(UV ord)
-    CODE:
-        RETVAL = isPSXSPC_L1(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPSXSPC_LC(UV ord)
-    CODE:
-        RETVAL = isPSXSPC_LC(ord);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPSXSPC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isPSXSPC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isPSXSPC_LC_utf8(unsigned char * p)
-    CODE:
-        RETVAL = isPSXSPC_LC_utf8( p);
-    OUTPUT:
-        RETVAL
-
-bool
-test_isQUOTEMETA(UV ord)
-    CODE:
-        RETVAL = _isQUOTEMETA(ord);
-    OUTPUT:
-        RETVAL
-
-UV
-test_toLOWER(UV ord)
-    CODE:
-        RETVAL = toLOWER(ord);
-    OUTPUT:
-        RETVAL
-
-UV
-test_toLOWER_L1(UV ord)
-    CODE:
-        RETVAL = toLOWER_L1(ord);
-    OUTPUT:
-        RETVAL
-
-UV
-test_toLOWER_LC(UV ord)
-    CODE:
-        RETVAL = toLOWER_LC(ord);
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toLOWER_uni(UV ord)
-    PREINIT:
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        av = newAV();
-        av_push(av, newSVuv(toLOWER_uni(ord, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toLOWER_utf8(SV * p)
-    PREINIT:
-        U8 *input;
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        input = (U8 *) SvPV(p, len);
-        av = newAV();
-        av_push(av, newSVuv(toLOWER_utf8(input, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
-
-UV
-test_toFOLD(UV ord)
-    CODE:
-        RETVAL = toFOLD(ord);
-    OUTPUT:
-        RETVAL
-
-UV
-test_toFOLD_LC(UV ord)
-    CODE:
-        RETVAL = toFOLD_LC(ord);
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toFOLD_uni(UV ord)
-    PREINIT:
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        av = newAV();
-        av_push(av, newSVuv(toFOLD_uni(ord, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toFOLD_utf8(SV * p)
-    PREINIT:
-        U8 *input;
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        input = (U8 *) SvPV(p, len);
-        av = newAV();
-        av_push(av, newSVuv(toFOLD_utf8(input, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
-
-UV
-test_toUPPER(UV ord)
-    CODE:
-        RETVAL = toUPPER(ord);
-    OUTPUT:
-        RETVAL
-
-UV
-test_toUPPER_LC(UV ord)
-    CODE:
-        RETVAL = toUPPER_LC(ord);
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toUPPER_uni(UV ord)
-    PREINIT:
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        av = newAV();
-        av_push(av, newSVuv(toUPPER_uni(ord, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toUPPER_utf8(SV * p)
-    PREINIT:
-        U8 *input;
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        input = (U8 *) SvPV(p, len);
-        av = newAV();
-        av_push(av, newSVuv(toUPPER_utf8(input, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
-
-UV
-test_toTITLE(UV ord)
-    CODE:
-        RETVAL = toTITLE(ord);
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toTITLE_uni(UV ord)
-    PREINIT:
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        av = newAV();
-        av_push(av, newSVuv(toTITLE_uni(ord, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
-
-AV *
-test_toTITLE_utf8(SV * p)
-    PREINIT:
-        U8 *input;
-        U8 s[UTF8_MAXBYTES_CASE + 1];
-        STRLEN len;
-        AV *av;
-        SV *utf8;
-    CODE:
-        input = (U8 *) SvPV(p, len);
-        av = newAV();
-        av_push(av, newSVuv(toTITLE_utf8(input, s, &len)));
-
-        utf8 = newSVpvn((char *) s, len);
-        SvUTF8_on(utf8);
-        av_push(av, utf8);
-
-        av_push(av, newSVuv(len));
-        RETVAL = av;
-    OUTPUT:
-        RETVAL
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/Makefile.PL b/gnu/usr.bin/perl/ext/XS-APItest/Makefile.PL
index 031ce8a0b0a..10ce8774ad8 100644
--- a/gnu/usr.bin/perl/ext/XS-APItest/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/XS-APItest/Makefile.PL
@@ -1,42 +1,33 @@
 use 5.008;
 use ExtUtils::MakeMaker;
 use ExtUtils::Constant 0.11 'WriteConstants';
-use Config;
-
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
 WriteMakefile(
     'NAME'		=> 'XS::APItest',
     'VERSION_FROM'	=> 'APItest.pm', # finds $VERSION
     'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
-    ABSTRACT_FROM	=> 'APItest.pm', # retrieve abstract from module
-    AUTHOR		=> 'Tim Jenness <t.jenness@jach.hawaii.edu>, Christian Soeller <csoelle@mph.auckland.ac.nz>, Hugo van der Sanden <hv@crypt.compulink.co.uk>, Andrew Main (Zefram) <zefram@fysh.org>',
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => 'APItest.pm', # retrieve abstract from module
+       AUTHOR     => 'Tim Jenness <t.jenness@jach.hawaii.edu>, Christian Soeller <csoelle@mph.auckland.ac.nz>, Hugo van der Sanden <hv@crypt.compulink.co.uk>') : ()),
     'C'                 => ['exception.c', 'core.c', 'notcore.c'],
-    'OBJECT'            => '$(BASEEXT)$(OBJ_EXT) XSUB-undef-XS_VERSION$(OBJ_EXT) XSUB-redefined-macros$(OBJ_EXT) $(O_FILES)',
+    'OBJECT'            => '$(BASEEXT)$(OBJ_EXT) $(O_FILES)',
+    'LIBS'		=> [''], # e.g., '-lm'
+    'DEFINE'		=> '', # e.g., '-DHAVE_SOMETHING'
+    'INC'		=> '-I.', # e.g., '-I. -I/usr/include/other'
+	# Un-comment this if you add C files to link with later:
+    # 'OBJECT'		=> '$(O_FILES)', # link all the C files too
     realclean => {FILES	=> 'const-c.inc const-xs.inc'},
-    ($Config{gccversion} && $Config{d_attribute_deprecated} ?
-      (CCFLAGS => $Config{ccflags} . ' -Wno-deprecated-declarations') : ()),
-    depend => { 'core.o' => 'core_or_not.inc',
-		'notcore.o' => 'core_or_not.inc' },
 );
 
-my @names = (qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
-		HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV
-		G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
-		G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL
-		IS_NUMBER_IN_UV IS_NUMBER_GREATER_THAN_UV_MAX
-		IS_NUMBER_NOT_INT IS_NUMBER_NEG IS_NUMBER_INFINITY
-		IS_NUMBER_NAN
-		),
-	     {name=>"G_WANT", default=>["IV", "G_ARRAY|G_VOID"]});
-
-open my $fh, '../../overload.h' or die "Can't open ../../overload.h: $!";
-while (<$fh>) {
-    push @names, {name => $1, macro => 1} if /^\s+([A-Za-z_0-9]+_amg),/;
-}
-
 WriteConstants(
     PROXYSUBS => 1,
     NAME => 'XS::APItest',
-    NAMES => \@names,
+    NAMES => [qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
+		 HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV
+		 G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
+		 G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL),
+	      {name=>"G_WANT", default=>["IV", "G_ARRAY|G_VOID"]}],
 	       );
 
 sub MY::install { "install ::\n"  };
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/core_or_not.inc b/gnu/usr.bin/perl/ext/XS-APItest/core_or_not.inc
index 9c1cf561d59..8fa32349cb0 100644
--- a/gnu/usr.bin/perl/ext/XS-APItest/core_or_not.inc
+++ b/gnu/usr.bin/perl/ext/XS-APItest/core_or_not.inc
@@ -16,7 +16,7 @@ CAT2(sv_setsv_cow_hashkey_, SUFFIX) () {
     SV *destination = newSV(0);
     bool result;
 
-    if(!SvIsCOW(source)) {
+    if(!SvREADONLY(source) && !SvFAKE(source)) {
 	SvREFCNT_dec(source);
 	Perl_croak(aTHX_ "Creating a shared hash key scalar failed when "
 	       STRINGIFY(SUFFIX) " got flags %"UVxf, (UV)SvFLAGS(source));
@@ -24,7 +24,7 @@ CAT2(sv_setsv_cow_hashkey_, SUFFIX) () {
 
     sv_setsv(destination, source);
 
-    result = !!SvIsCOW(destination);
+    result = SvREADONLY(destination) && SvFAKE(destination);
 
     SvREFCNT_dec(source);
     SvREFCNT_dec(destination);
@@ -37,8 +37,8 @@ CAT2(sv_setsv_cow_hashkey_, SUFFIX) () {
  * mode: c
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: nil
+ * indent-tabs-mode: t
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 et:
+ * ex: set ts=8 sts=4 sw=4 noet:
  */
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/t/call.t b/gnu/usr.bin/perl/ext/XS-APItest/t/call.t
index 54f45ec4892..f06ae885072 100755
--- a/gnu/usr.bin/perl/ext/XS-APItest/t/call.t
+++ b/gnu/usr.bin/perl/ext/XS-APItest/t/call.t
@@ -3,24 +3,33 @@
 # test the various call-into-perl-from-C functions
 # DAPM Aug 2004
 
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+	# Look, I'm using this fully-qualified variable more than once!
+	my $arch = $MacPerl::Architecture;
+        print "1..0 # Skip: XS::APItest was not built\n";
+        exit 0;
+    }
+}
+
 use warnings;
 use strict;
 
 # Test::More doesn't have fresh_perl_is() yet
-# use Test::More tests => 342;
+# use Test::More tests => 240;
 
 BEGIN {
-    require '../../t/test.pl';
-    plan(437);
+    require './test.pl';
+    plan(240);
     use_ok('XS::APItest')
 };
 
 #########################
 
-# f(): general test sub to be called by call_sv() etc.
-# Return the called args, but with the first arg replaced with 'b',
-# and the last arg replaced with x/y/z depending on context
-#
 sub f {
     shift;
     unshift @_, 'b';
@@ -28,14 +37,8 @@ sub f {
     @_, defined wantarray ? wantarray ? 'x' :  'y' : 'z';
 }
 
-our $call_sv_count = 0;
-sub i {
-    $call_sv_count++;
-}
-call_sv_C();
-is($call_sv_count, 6, "call_sv_C passes");
-
 sub d {
+    no warnings 'misc'; # keep G_KEEPERR from emitting this as a warning
     die "its_dead_jim\n";
 }
 
@@ -51,6 +54,7 @@ sub Foo::meth {
 }
 
 sub Foo::d {
+    no warnings 'misc'; # keep G_KEEPERR from emitting this as a warning
     die "its_dead_jim\n";
 }
 
@@ -90,42 +94,31 @@ for my $test (
 	? [0] : [ undef, 1 ];
     for my $keep (0, G_KEEPERR) {
 	my $desc = $description . ($keep ? ' G_KEEPERR' : '');
-	my $exp_warn = $keep ? "\t(in cleanup) its_dead_jim\n" : "";
-	my $exp_err = $keep ? "before\n"
+	my $exp_err = $keep ? "before\n\t(in cleanup) its_dead_jim\n"
 			    : "its_dead_jim\n";
-	my $warn;
-	local $SIG{__WARN__} = sub { $warn .= $_[0] };
 	$@ = "before\n";
-	$warn = "";
 	ok(eq_array( [ call_sv('d', $flags|G_EVAL|$keep, @$args) ],
 		    $returnval),
 		    "$desc G_EVAL call_sv('d')");
 	is($@, $exp_err, "$desc G_EVAL call_sv('d') - \$@");
-	is($warn, $exp_warn, "$desc G_EVAL call_sv('d') - warning");
 
 	$@ = "before\n";
-	$warn = "";
 	ok(eq_array( [ call_pv('d', $flags|G_EVAL|$keep, @$args) ], 
 		    $returnval),
 		    "$desc G_EVAL call_pv('d')");
 	is($@, $exp_err, "$desc G_EVAL call_pv('d') - \$@");
-	is($warn, $exp_warn, "$desc G_EVAL call_pv('d') - warning");
 
 	$@ = "before\n";
-	$warn = "";
 	ok(eq_array( [ eval_sv('d()', $flags|$keep) ],
 		    $returnval),
 		    "$desc eval_sv('d()')");
 	is($@, $exp_err, "$desc eval_sv('d()') - \$@");
-	is($warn, $exp_warn, "$desc G_EVAL eval_sv('d') - warning");
 
 	$@ = "before\n";
-	$warn = "";
 	ok(eq_array( [ call_method('d', $flags|G_EVAL|$keep, $obj, @$args) ],
 		    $returnval),
 		    "$desc G_EVAL call_method('d')");
 	is($@, $exp_err, "$desc G_EVAL call_method('d') - \$@");
-	is($warn, $exp_warn, "$desc G_EVAL call_method('d') - warning");
     }
 
     ok(eq_array( [ sub { call_sv('f', $flags|G_NOARGS, "bad") }->(@$args) ],
@@ -156,50 +149,6 @@ for my $test (
 
 };
 
-{
-	# these are the ones documented in perlcall.pod
-	my @flags = (G_DISCARD, G_NOARGS, G_EVAL, G_KEEPERR);
-	my $mask = 0;
-	$mask |= $_ for (@flags);
-	is(unpack('%32b*', pack('l', $mask)), @flags,
-	  "G_DISCARD and the rest are separate bits");
-}
-
-foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
-    foreach my $outx ("", "xxyyzz\n", [qw(xx yy zz)]) {
-	my $warn;
-	local $SIG{__WARN__} = sub { $warn .= $_[0] };
-	$@ = $outx;
-	$warn = "";
-	call_sv(sub { die $inx if $inx }, G_VOID|G_EVAL);
-	ok ref($@) eq ref($inx) && $@ eq $inx;
-	$warn =~ s/ at [^\n]*\n\z//;
-	is $warn, "";
-	$@ = $outx;
-	$warn = "";
-	call_sv(sub { die $inx if $inx }, G_VOID|G_EVAL|G_KEEPERR);
-	ok ref($@) eq ref($outx) && $@ eq $outx;
-	$warn =~ s/ at [^\n]*\n\z//;
-	is $warn, $inx ? "\t(in cleanup) $inx" : "";
-    }
-}
-
-{
-    no warnings "misc";
-    my $warn = "";
-    local $SIG{__WARN__} = sub { $warn .= $_[0] };
-    call_sv(sub { die "aa\n" }, G_VOID|G_EVAL|G_KEEPERR);
-    is $warn, "";
-}
-
-{
-    no warnings "misc";
-    my $warn = "";
-    local $SIG{__WARN__} = sub { $warn .= $_[0] };
-    call_sv(sub { use warnings "misc"; die "aa\n" }, G_VOID|G_EVAL|G_KEEPERR);
-    is $warn, "\t(in cleanup) aa\n";
-}
-
 is(eval_pv('f()', 0), 'y', "eval_pv('f()', 0)");
 is(eval_pv('f(qw(a b c))', 0), 'y', "eval_pv('f(qw(a b c))', 0)");
 is(eval_pv('d()', 0), undef, "eval_pv('d()', 0)");
@@ -207,97 +156,11 @@ is($@, "its_dead_jim\n", "eval_pv('d()', 0) - \$@");
 is(eval { eval_pv('d()', 1) } , undef, "eval { eval_pv('d()', 1) }");
 is($@, "its_dead_jim\n", "eval { eval_pv('d()', 1) } - \$@");
 
-
-# #3719 - check that the eval call variants handle exceptions correctly,
-# and do the right thing with $@, both with and without G_KEEPERR set.
-
-sub f99 { 99 };
-
-
-for my $fn_type (0..2) { #   0:eval_pv   1:eval_sv   2:call_sv
-
-    my $warn_msg;
-    local $SIG{__WARN__} = sub { $warn_msg .= $_[0] };
-
-    for my $code_type (0..3) {
-
-	# call_sv can only handle function names, not code snippets
-	next if $fn_type == 2 and ($code_type == 1 or $code_type == 2);
-
-	my $code = (
-	    'f99',			    # ok
-	    '$x=',			    # compile-time err
-	    'BEGIN { die "die in BEGIN"}',  # compile-time exception
-	    'd', 			    # run-time exception
-	)[$code_type];
-
-	for my $keep (0, G_KEEPERR) {
-	    my $keep_desc = $keep ? 'G_KEEPERR' : '0';
-
-	    my $desc;
-	    my $expect = ($code_type == 0) ? 1 : 0;
-
-	    undef $warn_msg;
-	    $@ = 'pre-err';
-
-	    my @ret;
-	    if ($fn_type == 0) { # eval_pv
-		# eval_pv returns its result rather than a 'succeed' boolean
-		$expect = $expect ? '99' : undef;
-
-		# eval_pv doesn't support G_KEEPERR, but it has a croak
-		# boolean arg instead, so switch on that instead
-		if ($keep) {
-		    $desc = "eval { eval_pv('$code', 1) }";
-		    @ret = eval { eval_pv($code, 1); '99' };
-		    # die in eval returns empty list
-		    push @ret, undef unless @ret;
-		}
-		else {
-		    $desc = "eval_pv('$code', 0)";
-		    @ret = eval_pv($code, 0);
-		}
-	    }
-	    elsif ($fn_type == 1) { # eval_sv
-		$desc = "eval_sv('$code', G_ARRAY|$keep_desc)";
-		@ret = eval_sv($code, G_ARRAY|$keep);
-	    }
-	    elsif ($fn_type == 2) { # call_sv
-		$desc = "call_sv('$code', G_EVAL|G_ARRAY|$keep_desc)";
-		@ret = call_sv($code, G_EVAL|G_ARRAY|$keep);
-	    }
-	    is(scalar @ret, ($code_type == 0 && $fn_type != 0) ? 2 : 1,
-			    "$desc - number of returned args");
-	    is($ret[-1], $expect, "$desc - return value");
-
-	    if ($keep && $fn_type != 0) {
-		# G_KEEPERR doesn't propagate into inner evals, requires etc
-		unless ($keep && $code_type == 2) {
-		    is($@, 'pre-err', "$desc - \$@ unmodified");
-		}
-		$@ = $warn_msg;
-	    }
-	    else {
-		is($warn_msg, undef, "$desc - __WARN__ not called");
-		unlike($@, 'pre-err', "$desc - \$@ modified");
-	    }
-	    like($@,
-		(
-		    qr/^$/,
-		    qr/syntax error/,
-		    qr/die in BEGIN/,
-		    qr/its_dead_jim/,
-		)[$code_type],
-		"$desc - the correct error message");
-	}
-    }
-}
-
 # DAPM 9-Aug-04. A taint test in eval_sv() could die after setting up
 # a new jump level but before pushing an eval context, leading to
 # stack corruption
 
-fresh_perl_is(<<'EOF', "x=2", { switches => ['-T', '-I../../lib'] }, 'eval_sv() taint');
+fresh_perl_is(<<'EOF', "x=2", { switches => ['-T'] }, 'eval_sv() taint');
 use XS::APItest;
 
 my $x = 0;
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/t/hash.t b/gnu/usr.bin/perl/ext/XS-APItest/t/hash.t
index 8a8c607dd7b..c7581b2036b 100755
--- a/gnu/usr.bin/perl/ext/XS-APItest/t/hash.t
+++ b/gnu/usr.bin/perl/ext/XS-APItest/t/hash.t
@@ -1,9 +1,22 @@
 #!perl -w
 
+BEGIN {
+  chdir 't' if -d 't';
+  @INC = '../lib';
+  push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+  require Config; import Config;
+  if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+    # Look, I'm using this fully-qualified variable more than once!
+    my $arch = $MacPerl::Architecture;
+    print "1..0 # Skip: XS::APItest was not built\n";
+    exit 0;
+  }
+}
+
 use strict;
 use utf8;
 use Tie::Hash;
-use Test::More;
+use Test::More 'no_plan';
 
 BEGIN {use_ok('XS::APItest')};
 
@@ -40,12 +53,12 @@ main_tests (\@keys, \@testkeys, ' [utf8 hash]');
   my $result = ($] > 5.009) ? undef : 1;
 
   is (XS::APItest::Hash::store(\%h, chr 258,  1), $result);
-
+    
   ok (!exists $h{$utf8_for_258},
       "hv_store doesn't insert a key with the raw utf8 on a tied hash");
 }
 
-{
+if ($] > 5.009) {
     my $strtab = strtab();
     is (ref $strtab, 'HASH', "The shared string table quacks like a hash");
     my $wibble = "\0";
@@ -85,7 +98,7 @@ foreach my $in ("", "N", "a\0b") {
     is ($got, $in, "test_share_unshare_pvn");
 }
 
-{
+if ($] > 5.009) {
     foreach ([\&XS::APItest::Hash::rot13_hash, \&rot13, "rot 13"],
 	     [\&XS::APItest::Hash::bitflip_hash, \&bitflip, "bitflip"],
 	    ) {
@@ -180,108 +193,6 @@ sub test_precomputed_hashes {
     }
 }
 
-{
-    use Scalar::Util 'weaken';
-    my %h;
-    fill_hash_with_nulls(\%h);
-    my @objs;
-    for("a".."z","A".."Z") {
-	weaken($objs[@objs] = $h{$_} = []);
-    }
-    undef %h;
-    no warnings 'uninitialized';
-    local $" = "";
-    is "@objs", "",
-      'explicitly undeffing a hash with nulls frees all entries';
-
-    my $h = {};
-    fill_hash_with_nulls($h);
-    @objs = ();
-    for("a".."z","A".."Z") {
-	weaken($objs[@objs] = $$h{$_} = []);
-    }
-    undef $h;
-    is "@objs", "", 'freeing a hash with nulls frees all entries';
-}
-
-# Tests for HvENAME and UTF8
-{
-    no strict;
-    no warnings 'void';
-    my $hvref;
-
-    *{"\xff::bar"}; # autovivify %ÿ:: without UTF8
-    *{"\xff::bαr::"} = $hvref = \%foo::;
-    undef *foo::;
-    is HvENAME($hvref), "\xff::bαr",
-	'stash alias (utf8 inside bytes) does not create malformed UTF8';
-
-    *{"é::foo"}; # autovivify %é:: with UTF8
-    *{"\xe9::\xe9::"} = $hvref = \%bar::;
-    undef *bar::;
-    is HvENAME($hvref), "\xe9::\xe9",
-	'stash alias (bytes inside utf8) does not create malformed UTF8';
-
-    *{"\xfe::bar"}; *{"\xfd::bar"};
-    *{"\xfe::bαr::"} = \%goo::;
-    *{"\xfd::bαr::"} = $hvref = \%goo::;
-    undef *goo::;
-    like HvENAME($hvref), qr/^[\xfe\xfd]::bαr\z/,
-	'multiple stash aliases (utf8 inside bytes) do not cause bad UTF8';
-
-    *{"è::foo"}; *{"ë::foo"};
-    *{"\xe8::\xe9::"} = $hvref = \%bear::;
-    *{"\xeb::\xe9::"} = \%bear::;
-    undef *bear::;
-    like HvENAME($hvref), qr"^[\xe8\xeb]::\xe9\z",
-	'multiple stash aliases (bytes inside utf8) do not cause bad UTF8';
-}
-
-{ # newHVhv
-    use Tie::Hash;
-    tie my %h, 'Tie::StdHash';
-    %h = 1..10;
-    is join(' ', sort %{newHVhv \%h}), '1 10 2 3 4 5 6 7 8 9',
-      'newHVhv on tied hash';
-}
-
-# helem and hslice on entry with null value
-# This is actually a test for a Perl operator, not an XS API test.  But it
-# requires a hash that can only be produced by XS (although recently it
-# could be encountered when tying hint hashes).
-{
-    my %h;
-    fill_hash_with_nulls(\%h);
-    eval{ $h{84} = 1 };
-    pass 'no crash when writing to hash elem with null value';
-    eval{ no # silly
-	  warnings; # thank you!
-	  @h{85} = 1 };
-    pass 'no crash when writing to hash elem with null value via slice';
-    eval { delete local $h{86} };
-    pass 'no crash during local deletion of hash elem with null value';
-    eval { delete local @h{87,88} };
-    pass 'no crash during local deletion of hash slice with null values';
-}
-
-# [perl #111000] Bug number eleventy-one thousand:
-#                hv_store should work on hint hashes
-eval q{
-    BEGIN {
-	XS::APItest::Hash::store \%^H, "XS::APItest/hash.t", undef;
-	delete $^H{"XS::APItest/hash.t"};
-    }
-};
-pass("hv_store works on the hint hash");
-
-{
-    # [perl #79074] HeSVKEY_force loses UTF8ness
-    my %hash = ( "\xff" => 1, "\x{100}" => 1 );
-    my @keys = sort ( XS::APItest::Hash::test_force_keys(\%hash) );
-    is_deeply(\@keys, [ sort keys %hash ], "check HeSVKEY_force()");
-}
-
-done_testing;
 exit;
 
 ################################   The End   ################################
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/t/printf.t b/gnu/usr.bin/perl/ext/XS-APItest/t/printf.t
index 76cc19fcaf0..ef2769e8fac 100755
--- a/gnu/usr.bin/perl/ext/XS-APItest/t/printf.t
+++ b/gnu/usr.bin/perl/ext/XS-APItest/t/printf.t
@@ -1,3 +1,14 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+        print "1..0 # Skip: XS::APItest was not built\n";
+        exit 0;
+    }
+}
+
 use Test::More tests => 11;
 
 BEGIN { use_ok('XS::APItest') };
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/t/svpeek.t b/gnu/usr.bin/perl/ext/XS-APItest/t/svpeek.t
index 5d18297ce5a..69d80d75838 100755
--- a/gnu/usr.bin/perl/ext/XS-APItest/t/svpeek.t
+++ b/gnu/usr.bin/perl/ext/XS-APItest/t/svpeek.t
@@ -1,7 +1,18 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+        print "1..0 # Skip: XS::APItest was not built\n";
+        exit 0;
+    }
+}
+
 use strict;
 use warnings;
 
-use Test::More tests => 52;
+use Test::More tests => 50;
 
 BEGIN { use_ok('XS::APItest') };
 
@@ -10,7 +21,7 @@ $| = 1;
   is (DPeek ($/),    'PVMG("\n"\0)',		'$/');
   is (DPeek ($\),    'PVMG()',			'$\\');
   is (DPeek ($.),    'PVMG()',			'$.');
-  is (DPeek ($,),    'UNDEF',			'$,');
+  is (DPeek ($,),    'PVMG()',			'$,');
   is (DPeek ($;),    'PV("\34"\0)',		'$;');
   is (DPeek ($"),    'PV(" "\0)',		'$"');
   is (DPeek ($:),    'PVMG(" \n-"\0)',		'$:');
@@ -47,12 +58,7 @@ like (DPeek ($1), qr'^PVMG\("',			' $1');
   is (DPeek (sub {}),	'\CV(__ANON__)',	'sub {}');
 
 { our ($VAR, @VAR, %VAR);
-if ($^O eq 'vos') {
-  # VOS uses .pm as a required executable suffix
-  open VAR, "<", "$^X.pm" or die "Can't open $^X.pm: $!";
-} else {
   open VAR, "<", $^X or die "Can't open $^X: $!";
-}
   sub VAR {}
   format VAR =
 .
@@ -68,17 +74,15 @@ if ($^O eq 'vos') {
   $VAR = "\xa8";
   is (DPeek ($VAR),	'PVIV("\250"\0)',	' $VAR "\xa8"');
   is (DPeek (\$VAR),	'\PVIV("\250"\0)',	'\$VAR "\xa8"');
-  $VAR = "a\x0a\x{20ac}";
-  is (DPeek ($VAR), 'PVIV("a\n\342\202\254"\0) [UTF8 "a\n\x{20ac}"]',
-					' $VAR "a\x0a\x{20ac}"');
+  SKIP: {
+      $] <= 5.008001 and skip "UTF8 tests useless in this ancient perl version", 1;
+      $VAR = "a\x0a\x{20ac}";
+      is (DPeek ($VAR), 'PVIV("a\n\342\202\254"\0) [UTF8 "a\n\x{20ac}"]',
+						  ' $VAR "a\x0a\x{20ac}"');
+      }
   $VAR = sub { "VAR" };
   is (DPeek ($VAR),	'\CV(__ANON__)',	' $VAR sub { "VAR" }');
   is (DPeek (\$VAR),	'\\\CV(__ANON__)',	'\$VAR sub { "VAR" }');
-  
-  $VAR = eval qq{sub \x{30cd} { "VAR" } \\&\x{30cd}};
-  is (DPeek ($VAR),     '\CV(\x{30cd})',        ' $VAR sub \x{30cd} { "VAR" }');
-  is (DPeek (\$VAR),    '\\\\CV(\x{30cd})',      '\$VAR sub \x{30cd} { "VAR" }');
-
   $VAR = 0;
 
   is (DPeek (\&VAR),	'\CV(VAR)',		'\&VAR');
diff --git a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm
index de3319b0594..04776f0abbb 100644
--- a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm
+++ b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm
@@ -31,31 +31,25 @@ to the test script.
 
 =cut
 
-use parent qw/ Exporter /;
-require XSLoader;
+use base qw/ DynaLoader Exporter /;
+
 
 use vars qw/ $VERSION @EXPORT /;
 
-$VERSION = '0.13';
+$VERSION = '0.03';
 
 @EXPORT = (qw/
 	   T_SV
 	   T_SVREF
-	   T_SVREF_REFCOUNT_FIXED
 	   T_AVREF
-	   T_AVREF_REFCOUNT_FIXED
 	   T_HVREF
-	   T_HVREF_REFCOUNT_FIXED
 	   T_CVREF
-	   T_CVREF_REFCOUNT_FIXED
 	   T_SYSRET_fail T_SYSRET_pass
 	   T_UV
 	   T_IV
 	   T_INT
            T_ENUM
            T_BOOL
-           T_BOOL_2
-           T_BOOL_OUT
            T_U_INT
            T_SHORT
            T_U_SHORT
@@ -66,7 +60,7 @@ $VERSION = '0.13';
            T_FLOAT
            T_NV
 	   T_DOUBLE
-	   T_PV T_PV_null
+	   T_PV
 	   T_PTR_IN T_PTR_OUT
 	   T_PTRREF_IN T_PTRREF_OUT
 	   T_REF_IV_REF
@@ -77,12 +71,10 @@ $VERSION = '0.13';
            T_OPAQUEPTR_IN_struct T_OPAQUEPTR_OUT_struct
 	   T_ARRAY
 	   T_STDIO_open T_STDIO_close T_STDIO_print
-           T_PACKED_in T_PACKED_out
-           T_PACKEDARRAY_in T_PACKEDARRAY_out
-           T_INOUT T_IN T_OUT
 	   /);
 
-XSLoader::load();
+
+bootstrap XS::Typemap;
 
 =head1 NOTES
 
diff --git a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs
index 3fa0e74abc7..dbb17338564 100644
--- a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs
+++ b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs
@@ -1,3 +1,4 @@
+
 /*
    XS code to test the typemap entries
 
@@ -6,8 +7,6 @@
 
 */
 
-#define PERL_NO_GET_CONTEXT
-
 #include "EXTERN.h"   /* std perl include */
 #include "perl.h"     /* std perl include */
 #include "XSUB.h"     /* XSUB include */
@@ -25,15 +24,10 @@ typedef int intRef; /* T_PTRREF */
 typedef int intObj; /* T_PTROBJ */
 typedef int intRefIv; /* T_REF_IV_PTR */
 typedef int intArray; /* T_ARRAY */
-typedef int intTINT; /* T_INT */
-typedef int intTLONG; /* T_LONG */
 typedef short shortOPQ;   /* T_OPAQUE */
 typedef int intOpq;   /* T_OPAQUEPTR */
-typedef unsigned intUnsigned; /* T_U_INT */
-typedef PerlIO * inputfh; /* T_IN */
-typedef PerlIO * outputfh; /* T_OUT */
 
-/* A structure to test T_OPAQUEPTR and T_PACKED */
+/* A structure to test T_OPAQUEPTR */
 struct t_opaqueptr {
   int a;
   int b;
@@ -41,7 +35,6 @@ struct t_opaqueptr {
 };
 
 typedef struct t_opaqueptr astruct;
-typedef struct t_opaqueptr anotherstruct;
 
 /* Some static memory for the tests */
 static I32 xst_anint;
@@ -50,13 +43,6 @@ static intObj xst_anintobj;
 static intRefIv xst_anintrefiv;
 static intOpq xst_anintopq;
 
-/* A different type to refer to for testing the different
- * AV*, HV*, etc typemaps */
-typedef AV AV_FIXED;
-typedef HV HV_FIXED;
-typedef CV CV_FIXED;
-typedef SVREF SVREF_FIXED;
-
 /* Helper functions */
 
 /* T_ARRAY - allocate some memory */
@@ -66,190 +52,26 @@ intArray * intArrayPtr( int nelem ) {
     return array;
 }
 
-/* test T_PACKED */
-STATIC void
-XS_pack_anotherstructPtr(SV *out, anotherstruct *in)
-{
-    dTHX;
-    HV *hash = newHV();
-    if (NULL == hv_stores(hash, "a", newSViv(in->a)))
-      croak("Failed to store data in hash");
-    if (NULL == hv_stores(hash, "b", newSViv(in->b)))
-      croak("Failed to store data in hash");
-    if (NULL == hv_stores(hash, "c", newSVnv(in->c)))
-      croak("Failed to store data in hash");
-    sv_setsv(out, sv_2mortal(newRV_noinc((SV*)hash)));
-}
 
-STATIC anotherstruct *
-XS_unpack_anotherstructPtr(SV *in)
-{
-    dTHX; /* rats, this is expensive */
-    /* this is similar to T_HVREF since we chose to use a hash */
-    HV *inhash;
-    SV **elem;
-    anotherstruct *out;
-    SV *const tmp = in;
-    SvGETMAGIC(tmp);
-    if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV)
-       inhash = (HV*)SvRV(tmp);
-    else
-        Perl_croak(aTHX_ "Argument is not a HASH reference");
-
-    /* FIXME dunno if supposed to use perl mallocs here */
-    Newxz(out, 1, anotherstruct);
-
-    elem = hv_fetchs(inhash, "a", 0);
-    if (elem == NULL)
-      Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-    out->a = SvIV(*elem);
-
-    elem = hv_fetchs(inhash, "b", 0);
-    if (elem == NULL)
-      Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-    out->b = SvIV(*elem);
-
-    elem = hv_fetchs(inhash, "c", 0);
-    if (elem == NULL)
-      Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-    out->c = SvNV(*elem);
-
-    return out;
-}
+MODULE = XS::Typemap   PACKAGE = XS::Typemap
 
-/* test T_PACKEDARRAY */
-STATIC void
-XS_pack_anotherstructPtrPtr(SV *out, anotherstruct **in, UV cnt)
-{
-    dTHX;
-    UV i;
-    AV *ary = newAV();
-    for (i = 0; i < cnt; ++i) {
-        HV *hash = newHV();
-        if (NULL == hv_stores(hash, "a", newSViv(in[i]->a)))
-          croak("Failed to store data in hash");
-        if (NULL == hv_stores(hash, "b", newSViv(in[i]->b)))
-          croak("Failed to store data in hash");
-        if (NULL == hv_stores(hash, "c", newSVnv(in[i]->c)))
-          croak("Failed to store data in hash");
-        av_push(ary, newRV_noinc((SV*)hash));
-    }
-    sv_setsv(out, sv_2mortal(newRV_noinc((SV*)ary)));
-}
+PROTOTYPES: DISABLE
 
-STATIC anotherstruct **
-XS_unpack_anotherstructPtrPtr(SV *in)
-{
-    dTHX; /* rats, this is expensive */
-    /* this is similar to T_HVREF since we chose to use a hash */
-    HV *inhash;
-    AV *inary;
-    SV **elem;
-    anotherstruct **out;
-    UV nitems, i;
-    SV *tmp;
-
-    /* safely deref the input array ref */
-    tmp = in;
-    SvGETMAGIC(tmp);
-    if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVAV)
-        inary = (AV*)SvRV(tmp);
-    else
-        Perl_croak(aTHX_ "Argument is not an ARRAY reference");
-
-    nitems = av_tindex(inary) + 1;
-
-    /* FIXME dunno if supposed to use perl mallocs here */
-    /* N+1 elements so we know the last one is NULL */
-    Newxz(out, nitems+1, anotherstruct*);
-
-    /* WARNING: in real code, we'd have to Safefree() on exception, but
-     *          since we're testing perl, if we croak() here, stuff is
-     *          rotten anyway! */
-    for (i = 0; i < nitems; ++i) {
-        Newxz(out[i], 1, anotherstruct);
-        elem = av_fetch(inary, i, 0);
-        if (elem == NULL)
-            Perl_croak(aTHX_ "Shouldn't happen: av_fetch returns NULL");
-        tmp = *elem;
-        SvGETMAGIC(tmp);
-        if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV)
-            inhash = (HV*)SvRV(tmp);
-        else
-            Perl_croak(aTHX_ "Array element %"UVuf" is not a HASH reference", i);
-
-        elem = hv_fetchs(inhash, "a", 0);
-        if (elem == NULL)
-            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-        out[i]->a = SvIV(*elem);
-
-        elem = hv_fetchs(inhash, "b", 0);
-        if (elem == NULL)
-            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-        out[i]->b = SvIV(*elem);
-
-        elem = hv_fetchs(inhash, "c", 0);
-        if (elem == NULL)
-            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
-        out[i]->c = SvNV(*elem);
-    }
-
-    return out;
-}
+=head1 TYPEMAPS
 
-/* no special meaning as far as typemaps are concerned,
- * just for convenience */
-void
-XS_release_anotherstructPtrPtr(anotherstruct **in)
-{
-    unsigned int i = 0;
-    while (in[i] != NULL)
-        Safefree(in[i++]);
-    Safefree(in);
-}
+Each C type is represented by an entry in the typemap file that
+is responsible for converting perl variables (SV, AV, HV and CV) to
+and from that type.
 
+=over 4
 
-MODULE = XS::Typemap   PACKAGE = XS::Typemap
+=item T_SV
 
-PROTOTYPES: DISABLE
+This simply passes the C representation of the Perl variable (an SV*)
+in and out of the XS layer. This can be used if the C code wants
+to deal directly with the Perl variable.
 
-TYPEMAP: <<END_OF_TYPEMAP
-
-# Typemap file for typemap testing
-# includes bonus typemap entries
-# Mainly so that all the standard typemaps can be exercised even when
-# there is not a corresponding type explicitly identified in the standard
-# typemap
-
-svtype           T_ENUM
-intRef *         T_PTRREF
-intRef           T_IV
-intObj *         T_PTROBJ
-intObj           T_IV
-intRefIv *       T_REF_IV_PTR
-intRefIv         T_IV
-intArray *       T_ARRAY
-intOpq           T_IV
-intOpq   *       T_OPAQUEPTR
-intUnsigned      T_U_INT
-intTINT          T_INT
-intTLONG         T_LONG
-shortOPQ         T_OPAQUE
-shortOPQ *       T_OPAQUEPTR
-astruct *        T_OPAQUEPTR
-anotherstruct *  T_PACKED
-anotherstruct ** T_PACKEDARRAY
-AV_FIXED *	 T_AVREF_REFCOUNT_FIXED
-HV_FIXED *	 T_HVREF_REFCOUNT_FIXED
-CV_FIXED *	 T_CVREF_REFCOUNT_FIXED
-SVREF_FIXED	 T_SVREF_REFCOUNT_FIXED
-inputfh          T_IN
-outputfh         T_OUT
-
-END_OF_TYPEMAP
-
-
-## T_SV
+=cut
 
 SV *
 T_SV( sv )
@@ -266,8 +88,11 @@ T_SV( sv )
  OUTPUT:
   RETVAL
 
+=item T_SVREF
+
+Used to pass in and return a reference to an SV.
 
-## T_SVREF
+=cut
 
 SVREF
 T_SVREF( svref )
@@ -277,20 +102,12 @@ T_SVREF( svref )
  OUTPUT:
   RETVAL
 
+=item T_AVREF
 
-## T_SVREF_FIXED
-
-SVREF_FIXED
-T_SVREF_REFCOUNT_FIXED( svref )
-  SVREF_FIXED svref
- CODE:
-  SvREFCNT_inc(svref);
-  RETVAL = svref;
- OUTPUT:
-  RETVAL
-
+From the perl level this is a reference to a perl array.
+From the C level this is a pointer to an AV.
 
-## T_AVREF
+=cut
 
 AV *
 T_AVREF( av )
@@ -300,20 +117,12 @@ T_AVREF( av )
  OUTPUT:
   RETVAL
 
+=item T_HVREF
 
-## T_AVREF_REFCOUNT_FIXED
-
-AV_FIXED*
-T_AVREF_REFCOUNT_FIXED( av )
-  AV_FIXED * av
- CODE:
-  SvREFCNT_inc(av);
-  RETVAL = av;
- OUTPUT:
-  RETVAL
-
+From the perl level this is a reference to a perl hash.
+From the C level this is a pointer to an HV.
 
-## T_HVREF
+=cut
 
 HV *
 T_HVREF( hv )
@@ -323,20 +132,13 @@ T_HVREF( hv )
  OUTPUT:
   RETVAL
 
+=item T_CVREF
 
-## T_HVREF_REFCOUNT_FIXED
-
-HV_FIXED*
-T_HVREF_REFCOUNT_FIXED( hv )
-  HV_FIXED * hv
- CODE:
-  SvREFCNT_inc(hv);
-  RETVAL = hv;
- OUTPUT:
-  RETVAL
-
+From the perl level this is a reference to a perl subroutine
+(e.g. $sub = sub { 1 };). From the C level this is a pointer
+to a CV.
 
-## T_CVREF
+=cut
 
 CV *
 T_CVREF( cv )
@@ -347,19 +149,22 @@ T_CVREF( cv )
   RETVAL
 
 
-## T_CVREF_REFCOUNT_FIXED
+=item T_SYSRET
 
-CV_FIXED *
-T_CVREF_REFCOUNT_FIXED( cv )
-  CV_FIXED * cv
- CODE:
-  SvREFCNT_inc(cv);
-  RETVAL = cv;
- OUTPUT:
-  RETVAL
+The T_SYSRET typemap is used to process return values from system calls.
+It is only meaningful when passing values from C to perl (there is
+no concept of passing a system return value from Perl to C).
 
+System calls return -1 on error (setting ERRNO with the reason)
+and (usually) 0 on success. If the return value is -1 this typemap
+returns C<undef>. If the return value is not -1, this typemap
+translates a 0 (perl false) to "0 but true" (which
+is perl true) or returns the value itself, to indicate that the
+command succeeded.
 
-## T_SYSRET
+The L<POSIX|POSIX> module makes extensive use of this type.
+
+=cut
 
 # Test a successful return
 
@@ -379,7 +184,11 @@ T_SYSRET_fail()
  OUTPUT:
   RETVAL
 
-## T_UV
+=item T_UV
+
+An unsigned integer.
+
+=cut
 
 unsigned int
 T_UV( uv )
@@ -389,8 +198,12 @@ T_UV( uv )
  OUTPUT:
   RETVAL
 
+=item T_IV
+
+A signed integer. This is cast to the required  integer type when
+passed to C and converted to an IV when passed back to Perl.
 
-## T_IV
+=cut
 
 long
 T_IV( iv )
@@ -400,19 +213,21 @@ T_IV( iv )
  OUTPUT:
   RETVAL
 
+=item T_INT
 
-## T_INT
+A signed integer. This typemap converts the Perl value to a native
+integer type (the C<int> type on the current platform). When returning
+the value to perl it is processed in the same way as for T_IV.
 
-intTINT
-T_INT( i )
-  intTINT i
- CODE:
-  RETVAL = i;
- OUTPUT:
-  RETVAL
+Its behaviour is identical to using an C<int> type in XS with T_IV.
+
+=item T_ENUM
 
+An enum value. Used to transfer an enum component
+from C. There is no reason to pass an enum value to C since
+it is stored as an IV inside perl.
 
-## T_ENUM
+=cut
 
 # The test should return the value for SVt_PVHV.
 # 11 at the present time but we can't not rely on this
@@ -425,8 +240,12 @@ T_ENUM()
  OUTPUT:
   RETVAL
 
+=item T_BOOL
 
-## T_BOOL
+A boolean type. This can be used to pass true and false values to and
+from C.
+
+=cut
 
 bool
 T_BOOL( in )
@@ -436,46 +255,27 @@ T_BOOL( in )
  OUTPUT:
   RETVAL
 
-bool
-T_BOOL_2( in )
-  bool in
- CODE:
-    PERL_UNUSED_VAR(RETVAL);
- OUTPUT:
-   in
-
-void
-T_BOOL_OUT( out, in )
-  bool out
-  bool in
- CODE:
- out = in;
- OUTPUT:
-   out
+=item T_U_INT
 
-## T_U_INT
+This is for unsigned integers. It is equivalent to using T_UV
+but explicitly casts the variable to type C<unsigned int>.
+The default type for C<unsigned int> is T_UV.
 
-intUnsigned
-T_U_INT( uint )
-  intUnsigned uint
- CODE:
-  RETVAL = uint;
- OUTPUT:
-  RETVAL
+=item T_SHORT
 
+Short integers. This is equivalent to T_IV but explicitly casts
+the return to type C<short>. The default typemap for C<short>
+is T_IV.
 
-## T_SHORT
+=item T_U_SHORT
 
-short
-T_SHORT( s )
-  short s
- CODE:
-  RETVAL = s;
- OUTPUT:
-  RETVAL
+Unsigned short integers. This is equivalent to T_UV but explicitly
+casts the return to type C<unsigned short>. The default typemap for
+C<unsigned short> is T_UV.
 
+T_U_SHORT is used for type C<U16> in the standard typemap.
 
-## T_U_SHORT
+=cut
 
 U16
 T_U_SHORT( in )
@@ -486,17 +286,21 @@ T_U_SHORT( in )
   RETVAL
 
 
-## T_LONG
+=item T_LONG
 
-intTLONG
-T_LONG( in )
-  intTLONG in
- CODE:
-  RETVAL = in;
- OUTPUT:
-  RETVAL
+Long integers. This is equivalent to T_IV but explicitly casts
+the return to type C<long>. The default typemap for C<long>
+is T_IV.
+
+=item T_U_LONG
+
+Unsigned long integers. This is equivalent to T_UV but explicitly
+casts the return to type C<unsigned long>. The default typemap for
+C<unsigned long> is T_UV.
+
+T_U_LONG is used for type C<U32> in the standard typemap.
 
-## T_U_LONG
+=cut
 
 U32
 T_U_LONG( in )
@@ -506,8 +310,11 @@ T_U_LONG( in )
  OUTPUT:
   RETVAL
 
+=item T_CHAR
 
-## T_CHAR
+Single 8-bit characters.
+
+=cut
 
 char
 T_CHAR( in );
@@ -518,7 +325,11 @@ T_CHAR( in );
   RETVAL
 
 
-## T_U_CHAR
+=item T_U_CHAR
+
+An unsigned byte.
+
+=cut
 
 unsigned char
 T_U_CHAR( in );
@@ -529,7 +340,12 @@ T_U_CHAR( in );
   RETVAL
 
 
-## T_FLOAT
+=item T_FLOAT
+
+A floating point number. This typemap guarantees to return a variable
+cast to a C<float>.
+
+=cut
 
 float
 T_FLOAT( in )
@@ -539,8 +355,13 @@ T_FLOAT( in )
  OUTPUT:
   RETVAL
 
+=item T_NV
+
+A Perl floating point number. Similar to T_IV and T_UV in that the
+return type is cast to the requested numeric type rather than
+to a specific type.
 
-## T_NV
+=cut
 
 NV
 T_NV( in )
@@ -550,8 +371,12 @@ T_NV( in )
  OUTPUT:
   RETVAL
 
+=item T_DOUBLE
 
-## T_DOUBLE
+A double precision floating point number. This typemap guarantees to
+return a variable cast to a C<double>.
+
+=cut
 
 double
 T_DOUBLE( in )
@@ -561,8 +386,11 @@ T_DOUBLE( in )
  OUTPUT:
   RETVAL
 
+=item T_PV
+
+A string (char *).
 
-## T_PV
+=cut
 
 char *
 T_PV( in )
@@ -572,15 +400,12 @@ T_PV( in )
  OUTPUT:
   RETVAL
 
-char *
-T_PV_null()
- CODE:
-  RETVAL = NULL;
- OUTPUT:
-  RETVAL
+=item T_PTR
 
+A memory address (pointer). Typically associated with a C<void *>
+type.
 
-## T_PTR
+=cut
 
 # Pass in a value. Store the value in some static memory and
 # then return the pointer
@@ -604,8 +429,16 @@ T_PTR_IN( ptr )
  OUTPUT:
   RETVAL
 
+=item T_PTRREF
 
-## T_PTRREF
+Similar to T_PTR except that the pointer is stored in a scalar and the
+reference to that scalar is returned to the caller. This can be used
+to hide the actual pointer value from the programmer since it is usually
+not required directly from within perl.
+
+The typemap checks that a scalar reference is passed from perl to XS.
+
+=cut
 
 # Similar test to T_PTR
 # Pass in a value. Store the value in some static memory and
@@ -631,7 +464,19 @@ T_PTRREF_IN( ptr )
   RETVAL
 
 
-## T_PTROBJ
+
+=item T_PTROBJ
+
+Similar to T_PTRREF except that the reference is blessed into a class.
+This allows the pointer to be used as an object. Most commonly used to
+deal with C structs. The typemap checks that the perl object passed
+into the XS routine is of the correct class (or part of a subclass).
+
+The pointer is blessed into a class that is derived from the name
+of type of the pointer but with all '*' in the name replaced with
+'Ptr'.
+
+=cut
 
 # Similar test to T_PTRREF
 # Pass in a value. Store the value in some static memory and
@@ -660,12 +505,21 @@ T_PTROBJ_IN( ptr )
 
 MODULE = XS::Typemap PACKAGE = XS::Typemap
 
+=item T_REF_IV_REF
+
+NOT YET
+
+=item T_REF_IV_PTR
 
-## T_REF_IV_REF
-## NOT YET
+Similar to T_PTROBJ in that the pointer is blessed into a scalar object.
+The difference is that when the object is passed back into XS it must be
+of the correct type (inheritance is not supported).
 
+The pointer is blessed into a class that is derived from the name
+of type of the pointer but with all '*' in the name replaced with
+'Ptr'.
 
-## T_REF_IV_PTR
+=cut
 
 # Similar test to T_PTROBJ
 # Pass in a value. Store the value in some static memory and
@@ -695,19 +549,37 @@ T_REF_IV_PTR_IN( ptr )
 
 MODULE = XS::Typemap PACKAGE = XS::Typemap
 
-## T_PTRDESC
-## NOT YET
+=item T_PTRDESC
 
+NOT YET
 
-## T_REFREF
-## NOT YET
+=item T_REFREF
 
+NOT YET
 
-## T_REFOBJ
-## NOT YET
+=item T_REFOBJ
 
+NOT YET
 
-## T_OPAQUEPTR
+=item T_OPAQUEPTR
+
+This can be used to store bytes in the string component of the
+SV. Here the representation of the data is irrelevant to perl and the
+bytes themselves are just stored in the SV. It is assumed that the C
+variable is a pointer (the bytes are copied from that memory
+location).  If the pointer is pointing to something that is
+represented by 8 bytes then those 8 bytes are stored in the SV (and
+length() will report a value of 8). This entry is similar to T_OPAQUE.
+
+In principal the unpack() command can be used to convert the bytes
+back to a number (if the underlying type is known to be a number).
+
+This entry can be used to store a C structure (the number
+of bytes to be copied is calculated using the C C<sizeof> function)
+and can be used as an alternative to T_PTRREF without having to worry
+about a memory leak (since Perl will clean up the SV).
+
+=cut
 
 intOpq *
 T_OPAQUEPTR_IN( val )
@@ -759,7 +631,24 @@ T_OPAQUEPTR_OUT_struct( test )
   XPUSHs(sv_2mortal(newSVnv(test->c)));
 
 
-## T_OPAQUE
+=item T_OPAQUE
+
+This can be used to store data from non-pointer types in the string
+part of an SV. It is similar to T_OPAQUEPTR except that the
+typemap retrieves the pointer directly rather than assuming it
+is being supplied. For example if an integer is imported into
+Perl using T_OPAQUE rather than T_IV the underlying bytes representing
+the integer will be stored in the SV but the actual integer value will not
+be available. i.e. The data is opaque to perl.
+
+The data may be retrieved using the C<unpack> function if the
+underlying type of the byte stream is known.
+
+T_OPAQUE supports input and output of simple types.
+T_OPAQUEPTR can be used to pass these bytes back into C if a pointer
+is acceptable.
+
+=cut
 
 shortOPQ
 T_OPAQUE_IN( val )
@@ -777,6 +666,25 @@ T_OPAQUE_OUT( val )
  OUTPUT:
   RETVAL
 
+=item Implicit array
+
+xsubpp supports a special syntax for returning
+packed C arrays to perl. If the XS return type is given as
+
+  array(type, nelem)
+
+xsubpp will copy the contents of C<nelem * sizeof(type)> bytes from
+RETVAL to an SV and push it onto the stack. This is only really useful
+if the number of items to be returned is known at compile time and you
+don't mind having a string of bytes in your SV.  Use T_ARRAY to push a
+variable number of arguments onto the return stack (they won't be
+packed as a single string though).
+
+This is similar to using T_OPAQUEPTR but can be used to process more than
+one element.
+
+=cut
+
 array(int,3)
 T_OPAQUE_array( a,b,c)
   int a
@@ -793,79 +701,57 @@ T_OPAQUE_array( a,b,c)
   RETVAL
 
 
-## T_PACKED
+=item T_PACKED
 
-void
-T_PACKED_in(in)
-  anotherstruct *in;
- PPCODE:
-  mXPUSHi(in->a);
-  mXPUSHi(in->b);
-  mXPUSHn(in->c);
-  Safefree(in);
-  XSRETURN(3);
-
-anotherstruct *
-T_PACKED_out(a, b ,c)
-  int a;
-  int b;
-  double c;
- CODE:
-  Newxz(RETVAL, 1, anotherstruct);
-  RETVAL->a = a;
-  RETVAL->b = b;
-  RETVAL->c = c;
- OUTPUT: RETVAL
- CLEANUP:
-  Safefree(RETVAL);
+NOT YET
 
-## T_PACKEDARRAY
+=item T_PACKEDARRAY
 
-void
-T_PACKEDARRAY_in(in)
-  anotherstruct **in;
- PREINIT:
-  unsigned int i = 0;
- PPCODE:
-  while (in[i] != NULL) {
-    mXPUSHi(in[i]->a);
-    mXPUSHi(in[i]->b);
-    mXPUSHn(in[i]->c);
-    ++i;
-  }
-  XS_release_anotherstructPtrPtr(in);
-  XSRETURN(3*i);
-
-anotherstruct **
-T_PACKEDARRAY_out(...)
- PREINIT:
-  unsigned int i, nstructs, count_anotherstructPtrPtr;
- CODE:
-  if ((items % 3) != 0)
-    croak("Need nitems divisible by 3");
-  nstructs = (unsigned int)(items / 3);
-  count_anotherstructPtrPtr = nstructs;
-  Newxz(RETVAL, nstructs+1, anotherstruct *);
-  for (i = 0; i < nstructs; ++i) {
-    Newxz(RETVAL[i], 1, anotherstruct);
-    RETVAL[i]->a = SvIV(ST(3*i));
-    RETVAL[i]->b = SvIV(ST(3*i+1));
-    RETVAL[i]->c = SvNV(ST(3*i+2));
-  }
- OUTPUT: RETVAL
- CLEANUP:
-  XS_release_anotherstructPtrPtr(RETVAL);
+NOT YET
+
+=item T_DATAUNIT
+
+NOT YET
+
+=item T_CALLBACK
+
+NOT YET
+
+=item T_ARRAY
+
+This is used to convert the perl argument list to a C array
+and for pushing the contents of a C array onto the perl
+argument stack.
 
+The usual calling signature is
 
-## T_DATAUNIT
-## NOT YET
+  @out = array_func( @in );
 
+Any number of arguments can occur in the list before the array but
+the input and output arrays must be the last elements in the list.
 
-## T_CALLBACK
-## NOT YET
+When used to pass a perl list to C the XS writer must provide a
+function (named after the array type but with 'Ptr' substituted for
+'*') to allocate the memory required to hold the list. A pointer
+should be returned. It is up to the XS writer to free the memory on
+exit from the function. The variable C<ix_$var> is set to the number
+of elements in the new array.
 
+When returning a C array to Perl the XS writer must provide an integer
+variable called C<size_$var> containing the number of elements in the
+array. This is used to determine how many elements should be pushed
+onto the return argument stack. This is not required on input since
+Perl knows how many arguments are on the stack when the routine is
+called. Ordinarily this variable would be called C<size_RETVAL>.
 
-## T_ARRAY
+Additionally, the type of each element is determined from the type of
+the array. If the array uses type C<intArray *> xsubpp will
+automatically work out that it contains variables of type C<int> and
+use that typemap entry to perform the copy of each element. All
+pointer '*' and 'Array' tags are removed from the name to determine
+the subtype.
+
+=cut
 
 # Test passes in an integer array and returns it along with
 # the number of elements
@@ -875,9 +761,6 @@ T_PACKEDARRAY_out(...)
 # using PPCODE. This means that only the first element
 # is returned. KLUGE this by using CLEANUP to return before the
 # end.
-# Note: I read this as: The "T_ARRAY" typemap is really rather broken,
-#       at least for OUTPUT. That is apart from the general design
-#       weaknesses. --Steffen
 
 intArray *
 T_ARRAY( dummy, array, ... )
@@ -896,7 +779,12 @@ T_ARRAY( dummy, array, ... )
   XSRETURN(size_RETVAL);
 
 
-## T_STDIO
+=item T_STDIO
+
+This is used for passing perl filehandles to and from C using
+C<FILE *> structures.
+
+=cut
 
 FILE *
 T_STDIO_open( file )
@@ -932,32 +820,24 @@ T_STDIO_print( stream, string )
   RETVAL
 
 
-## T_INOUT
+=item T_IN
 
-PerlIO *
-T_INOUT(in)
-  PerlIO *in;
- CODE:
-  RETVAL = in; /* silly test but better than nothing */
- OUTPUT: RETVAL
+NOT YET
 
+=item T_INOUT
 
-## T_IN
+This is used for passing perl filehandles to and from C using
+C<PerlIO *> structures. The file handle can used for reading and
+writing.
 
-inputfh
-T_IN(in)
-  inputfh in;
- CODE:
-  RETVAL = in; /* silly test but better than nothing */
- OUTPUT: RETVAL
+See L<perliol> for more information on the Perl IO abstraction
+layer. Perl must have been built with C<-Duseperlio>.
 
+=item T_OUT
 
-## T_OUT
+NOT YET
 
-outputfh
-T_OUT(in)
-  outputfh in;
- CODE:
-  RETVAL = in; /* silly test but better than nothing */
- OUTPUT: RETVAL
+=back
+
+=cut
 
diff --git a/gnu/usr.bin/perl/ext/XS-Typemap/t/Typemap.t b/gnu/usr.bin/perl/ext/XS-Typemap/t/Typemap.t
index e251c55e7f2..accb6c40d4c 100755
--- a/gnu/usr.bin/perl/ext/XS-Typemap/t/Typemap.t
+++ b/gnu/usr.bin/perl/ext/XS-Typemap/t/Typemap.t
@@ -1,4 +1,6 @@
 BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bXS\/Typemap\b/) {
         print "1..0 # Skip: XS::Typemap was not built\n";
@@ -6,241 +8,204 @@ BEGIN {
     }
 }
 
-use Test::More tests => 148;
+use Test;
+BEGIN { plan tests => 84 }
 
 use strict;
 use warnings;
 use XS::Typemap;
 
-pass();
+ok(1);
 
 # Some inheritance trees to check ISA relationships
 BEGIN {
   package intObjPtr::SubClass;
-  use parent '-norequire', qw/ intObjPtr /;
+  use base qw/ intObjPtr /;
   sub xxx { 1; }
 }
 
 BEGIN {
   package intRefIvPtr::SubClass;
-  use parent '-norequire', qw/ intRefIvPtr /;
+  use base qw/ intRefIvPtr /;
   sub xxx { 1 }
 }
 
 # T_SV - standard perl scalar value
-note("T_SV");
+print "# T_SV\n";
+
 my $sv = "Testing T_SV";
-is( T_SV($sv), $sv);
+ok( T_SV($sv), $sv);
 
 # T_SVREF - reference to Scalar
-note("T_SVREF");
+print "# T_SVREF\n";
+
 $sv .= "REF";
 my $svref = \$sv;
-is( T_SVREF($svref), $svref );
-is( ${ T_SVREF($svref) }, $$svref );
+ok( T_SVREF($svref), $svref );
 
 # Now test that a non reference is rejected
 # the typemaps croak
 eval { T_SVREF( "fail - not ref" ) };
 ok( $@ );
 
-note("T_SVREF_REFCOUNT_FIXED");
-is( T_SVREF_REFCOUNT_FIXED($svref), $svref );
-is( ${ T_SVREF_REFCOUNT_FIXED($svref) }, $$svref );
-eval { T_SVREF_REFCOUNT_FIXED( "fail - not ref" ) };
-ok( $@ );
-
-
 # T_AVREF - reference to a perl Array
-note("T_AVREF");
+print "# T_AVREF\n";
+
 my @array;
-is( T_AVREF(\@array), \@array);
-# Now test that a non array ref is rejected
-eval { T_AVREF( \$sv ) };
-ok( $@ );
+ok( T_AVREF(\@array), \@array);
 
-# T_AVREF_REFCOUNT_FIXED  - reference to a perl Array, refcount fixed
-note("T_AVREF_REFCOUNT_FIXED");
-is( T_AVREF_REFCOUNT_FIXED(\@array), \@array);
 # Now test that a non array ref is rejected
-eval { T_AVREF_REFCOUNT_FIXED( \$sv ) };
+eval { T_AVREF( \$sv ) };
 ok( $@ );
 
-
 # T_HVREF - reference to a perl Hash
-note("T_HVREF");
-my %hash;
-is( T_HVREF(\%hash), \%hash);
-# Now test that a non hash ref is rejected
-eval { T_HVREF( \@array ) };
-ok( $@ );
+print "# T_HVREF\n";
 
+my %hash;
+ok( T_HVREF(\%hash), \%hash);
 
-# T_HVREF_REFCOUNT_FIXED - reference to a perl Hash, refcount fixed
-note("T_HVREF_REFCOUNT_FIXED");
-is( T_HVREF_REFCOUNT_FIXED(\%hash), \%hash);
 # Now test that a non hash ref is rejected
-eval { T_HVREF_REFCOUNT_FIXED( \@array ) };
+eval { T_HVREF( \@array ) };
 ok( $@ );
 
 
 # T_CVREF - reference to perl subroutine
-note("T_CVREF");
+print "# T_CVREF\n";
 my $sub = sub { 1 };
-is( T_CVREF($sub), $sub );
-# Now test that a non code ref is rejected
-eval { T_CVREF( \@array ) };
-ok( $@ );
+ok( T_CVREF($sub), $sub );
 
-is( T_CVREF_REFCOUNT_FIXED($sub), $sub );
 # Now test that a non code ref is rejected
-eval { T_CVREF_REFCOUNT_FIXED( \@array ) };
+eval { T_CVREF( \@array ) };
 ok( $@ );
 
-
 # T_SYSRET - system return values
-note("T_SYSRET");
+print "# T_SYSRET\n";
+
 # first check success
 ok( T_SYSRET_pass );
+
 # ... now failure
-is( T_SYSRET_fail, undef);
+ok( T_SYSRET_fail, undef);
 
 # T_UV - unsigned integer
-note("T_UV");
-is( T_UV(5), 5 );    # pass
-isnt( T_UV(-4), -4); # fail
+print "# T_UV\n";
 
-# T_U_INT - unsigned integer with (unsigned int) cast
-note("T_U_INT");
-is( T_U_INT(5), 5 );    # pass
-isnt( T_U_INT(-4), -4); # fail
+ok( T_UV(5), 5 );    # pass
+ok( T_UV(-4) != -4); # fail
 
 # T_IV - signed integer
-# T_INT - signed integer with cast
-# T_LONG - signed integer with cast to IV
-# T_SHORT - signed short
-for my $t (['T_IV', \&T_IV],
-           ['T_INT', \&T_INT],
-           ['T_LONG', \&T_LONG],
-           ['T_SHORT', \&T_SHORT])
-{
-  note($t->[0]);
-  is( $t->[1]->(5), 5);
-  is( $t->[1]->(-4), -4);
-  is( $t->[1]->(4.1), int(4.1));
-  is( $t->[1]->("52"), "52");
-  isnt( $t->[1]->(4.5), 4.5); # failure
-}
+print "# T_IV\n";
+
+ok( T_IV(5), 5);
+ok( T_IV(-4), -4);
+ok( T_IV(4.1), int(4.1));
+ok( T_IV("52"), "52");
+ok( T_IV(4.5) != 4.5); # failure
 
-if ($Config{shortsize} == 2) {
-  isnt( T_SHORT(32801), 32801 );
-}
-else {
-  pass(); # e.g. Crays have shortsize 4 (T3X) or 8 (CXX and SVX)
-}
+
+# Skip T_INT
 
 # T_ENUM - enum list
-ok( T_ENUM(), 'T_ENUM' ); # just hope for a true value
+print "# T_ENUM\n";
+
+ok( T_ENUM() ); # just hope for a true value
 
 # T_BOOL - boolean
-note("T_BOOL");
+print "# T_BOOL\n";
 
 ok( T_BOOL(52) );
 ok( ! T_BOOL(0) );
 ok( ! T_BOOL('') );
 ok( ! T_BOOL(undef) );
 
-{
-  # these attempt to modify a read-only value
-  ok( !eval { T_BOOL_2(52); 1 } );
-  ok( !eval { T_BOOL_2(0); 1 } );
-  ok( !eval { T_BOOL_2(''); 1 } );
-  ok( !eval { T_BOOL_2(undef); 1 } );
-}
+# Skip T_U_INT
 
-{
-    my ($in, $out);
-    $in = 1;
-    T_BOOL_OUT($out, $in);
-    ok($out, "T_BOOL_OUT, true in");
-    $in = 0;
-    $out = 1;
-    T_BOOL_OUT($out, $in);
-    ok(!$out, "T_BOOL_OUT, false in");
-}
+# Skip T_SHORT
 
 # T_U_SHORT aka U16
-note("T_U_SHORT");
-is( T_U_SHORT(32000), 32000);
+
+print "# T_U_SHORT\n";
+
+ok( T_U_SHORT(32000), 32000);
 if ($Config{shortsize} == 2) {
-  isnt( T_U_SHORT(65536), 65536); # probably dont want to test edge cases
+  ok( T_U_SHORT(65536) != 65536); # probably dont want to test edge cases
 } else {
   ok(1); # e.g. Crays have shortsize 4 (T3X) or 8 (CXX and SVX)
 }
 
 # T_U_LONG aka U32
-note("T_U_LONG");
-is( T_U_LONG(65536), 65536);
-isnt( T_U_LONG(-1), -1);
+
+print "# T_U_LONG\n";
+
+ok( T_U_LONG(65536), 65536);
+ok( T_U_LONG(-1) != -1);
 
 # T_CHAR
-note("T_CHAR");
-is( T_CHAR("a"), "a");
-is( T_CHAR("-"), "-");
-is( T_CHAR(chr(128)),chr(128));
-isnt( T_CHAR(chr(256)), chr(256));
+
+print "# T_CHAR\n";
+
+ok( T_CHAR("a"), "a");
+ok( T_CHAR("-"), "-");
+ok( T_CHAR(chr(128)),chr(128));
+ok( T_CHAR(chr(256)) ne chr(256));
 
 # T_U_CHAR
-note("T_U_CHAR");
-is( T_U_CHAR(127), 127);
-is( T_U_CHAR(128), 128);
-isnt( T_U_CHAR(-1), -1);
-isnt( T_U_CHAR(300), 300);
+
+print "# T_U_CHAR\n";
+
+ok( T_U_CHAR(127), 127);
+ok( T_U_CHAR(128), 128);
+ok( T_U_CHAR(-1) != -1);
+ok( T_U_CHAR(300) != 300);
 
 # T_FLOAT
+print "# T_FLOAT\n";
+
 # limited precision
-is( sprintf("%6.3f",T_FLOAT(52.345)), sprintf("%6.3f",52.345), "T_FLOAT");
+ok( sprintf("%6.3f",T_FLOAT(52.345)), sprintf("%6.3f",52.345));
 
 # T_NV
-is( T_NV(52.345), 52.345, "T_NV" );
+print "# T_NV\n";
+
+ok( T_NV(52.345), 52.345);
 
 # T_DOUBLE
-is( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345), "T_DOUBLE" );
+print "# T_DOUBLE\n";
+
+ok( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345));
 
 # T_PV
-note("T_PV");
-is( T_PV("a string"), "a string");
-is( T_PV(52), 52);
-ok !defined T_PV_null, 'RETVAL = NULL returns undef for char*';
-{
-    my $uninit;
-    local $SIG{__WARN__} = sub { ++$uninit if shift =~ /uninit/ };
-    () = ''.T_PV_null;
-    is $uninit, 1, 'uninit warning from NULL returned from char* func';
-}
+print "# T_PV\n";
+
+ok( T_PV("a string"), "a string");
+ok( T_PV(52), 52);
 
 # T_PTR
+print "# T_PTR\n";
+
 my $t = 5;
 my $ptr = T_PTR_OUT($t);
-is( T_PTR_IN( $ptr ), $t, "T_PTR" );
+ok( T_PTR_IN( $ptr ), $t );
 
 # T_PTRREF
-note("T_PTRREF");
+print "# T_PTRREF\n";
+
 $t = -52;
 $ptr = T_PTRREF_OUT( $t );
-is( ref($ptr), "SCALAR");
-is( T_PTRREF_IN( $ptr ), $t );
+ok( ref($ptr), "SCALAR");
+ok( T_PTRREF_IN( $ptr ), $t );
 
 # test that a non-scalar ref is rejected
 eval { T_PTRREF_IN( $t ); };
 ok( $@ );
 
 # T_PTROBJ
-note("T_PTROBJ");
+print "# T_PTROBJ\n";
+
 $t = 256;
 $ptr = T_PTROBJ_OUT( $t );
-is( ref($ptr), "intObjPtr");
-is( $ptr->T_PTROBJ_IN, $t );
+ok( ref($ptr), "intObjPtr");
+ok( $ptr->T_PTROBJ_IN, $t );
 
 # check that normal scalar refs fail
 eval {intObjPtr::T_PTROBJ_IN( \$t );};
@@ -248,17 +213,18 @@ ok( $@ );
 
 # check that inheritance works
 bless $ptr, "intObjPtr::SubClass";
-is( ref($ptr), "intObjPtr::SubClass");
-is( $ptr->T_PTROBJ_IN, $t );
+ok( ref($ptr), "intObjPtr::SubClass");
+ok( $ptr->T_PTROBJ_IN, $t );
 
 # Skip T_REF_IV_REF
 
 # T_REF_IV_PTR
-note("T_REF_IV_PTR");
+print "# T_REF_IV_PTR\n";
+
 $t = -365;
 $ptr = T_REF_IV_PTR_OUT( $t );
-is( ref($ptr), "intRefIvPtr");
-is( $ptr->T_REF_IV_PTR_IN(), $t);
+ok( ref($ptr), "intRefIvPtr");
+ok( $ptr->T_REF_IV_PTR_IN(), $t);
 
 # inheritance should not work
 bless $ptr, "intRefIvPtr::SubClass";
@@ -272,90 +238,64 @@ ok( $@ );
 # Skip T_REFOBJ
 
 # T_OPAQUEPTR
-note("T_OPAQUEPTR");
+print "# T_OPAQUEPTR\n";
+
 $t = 22;
 my $p = T_OPAQUEPTR_IN( $t );
-is( T_OPAQUEPTR_OUT($p), $t);
+ok( T_OPAQUEPTR_OUT($p), $t);
 
 # T_OPAQUEPTR with a struct
-note("T_OPAQUEPTR with a struct");
+print "# T_OPAQUEPTR with a struct\n";
+
 my @test = (5,6,7);
 $p = T_OPAQUEPTR_IN_struct(@test);
 my @result = T_OPAQUEPTR_OUT_struct($p);
-is(scalar(@result),scalar(@test));
+ok(scalar(@result),scalar(@test));
 for (0..$#test) {
-  is($result[$_], $test[$_]);
+  ok($result[$_], $test[$_]);
 }
 
 # T_OPAQUE
-note("T_OPAQUE");
+print "# T_OPAQUE\n";
+
 $t = 48;
 $p = T_OPAQUE_IN( $t );
-is(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR
-is(T_OPAQUE_OUT( $p ), $t );         # Test using T_OPQAQUE
+ok(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR
+ok(T_OPAQUE_OUT( $p ), $t );         # Test using T_OPQAQUE
 
 # T_OPAQUE_array
-note("T_OPAQUE: A packed array");
+print "# A packed  array\n";
 
 my @opq = (2,4,8);
 my $packed = T_OPAQUE_array(@opq);
 my @uopq = unpack("i*",$packed);
-is(scalar(@uopq), scalar(@opq));
+ok(scalar(@uopq), scalar(@opq));
 for (0..$#opq) {
-  is( $uopq[$_], $opq[$_]);
+  ok( $uopq[$_], $opq[$_]);
 }
 
-# T_PACKED
-note("T_PACKED");
-my $struct = T_PACKED_out(-4, 3, 2.1);
-ok(ref($struct) eq 'HASH');
-is_approx($struct->{a}, -4);
-is_approx($struct->{b}, 3);
-is_approx($struct->{c}, 2.1);
-my @rv = T_PACKED_in($struct);
-is(scalar(@rv), 3);
-is_approx($rv[0], -4);
-is_approx($rv[1], 3);
-is_approx($rv[2], 2.1);
-
-# T_PACKEDARRAY
-SCOPE: {
-  note("T_PACKED_ARRAY");
-  my @d = (
-    -4, 3, 2.1,
-    2, 1, -15.3,
-    1,1,1
-  );
-  my @out;
-  push @out, {a => $d[$_*3], b => $d[$_*3+1], c => $d[$_*3+2]} for (0..2);
-  my $structs = T_PACKEDARRAY_out(@d);
-  ok(ref($structs) eq 'ARRAY');
-  is(scalar(@$structs), 3);
-  foreach my $i (0..2) {
-    my $s = $structs->[$i];
-    is(ref($s), 'HASH');
-    is_approx($s->{a}, $d[$i*3+0]);
-    is_approx($s->{b}, $d[$i*3+1]);
-    is_approx($s->{c}, $d[$i*3+2]);
-  }
-  my @rv = T_PACKEDARRAY_in($structs);
-  is(scalar(@rv), scalar(@d));
-  foreach my $i (0..$#d) {
-    is_approx($rv[$i], $d[$i]);
-  }
-}
+# Skip T_PACKED
+
+# Skip T_PACKEDARRAY
 
 # Skip T_DATAUNIT
 
 # Skip T_CALLBACK
 
 # T_ARRAY
+print "# T_ARRAY\n";
 my @inarr = (1,2,3,4,5,6,7,8,9,10);
 my @outarr = T_ARRAY( 5, @inarr );
-is_deeply(\@outarr, \@inarr, "T_ARRAY");
+ok(scalar(@outarr), scalar(@inarr));
+
+for (0..$#inarr) {
+  ok($outarr[$_], $inarr[$_]);
+}
+
+
 
 # T_STDIO
-note("T_STDIO");
+print "# T_STDIO\n";
 
 # open a file in XS for write
 my $testfile= "stdio.tmp";
@@ -368,7 +308,7 @@ if (defined $fh) {
   my @lines = ("NormalSTDIO\n", "PerlIO\n");
 
   # print to it using FILE* through XS
-  is( T_STDIO_print($fh, $lines[0]), length($lines[0]));
+  ok( T_STDIO_print($fh, $lines[0]), length($lines[0]));
 
   # print to it using normal perl
   ok(print $fh "$lines[1]");
@@ -380,9 +320,9 @@ if (defined $fh) {
   open($fh, "< $testfile");
   ok($fh);
   my $line = <$fh>;
-  is($line,$lines[0]);
+  ok($line,$lines[0]);
   $line = <$fh>;
-  is($line,$lines[1]);
+  ok($line,$lines[1]);
 
   ok(close($fh));
   ok(unlink($testfile));
@@ -393,53 +333,3 @@ if (defined $fh) {
   }
 }
 
-# T_INOUT
-note("T_INOUT");
-SCOPE: {
-  my $buf = '';
-  local $| = 1;
-  open my $fh, "+<", \$buf or die $!;
-  my $str = "Fooo!\n";
-  print $fh $str;
-  my $fh2 = T_INOUT($fh);
-  seek($fh2, 0, 0);
-  is(readline($fh2), $str);
-  ok(print $fh2 "foo\n");
-}
-
-# T_IN
-note("T_IN");
-SCOPE: {
-  my $buf = "Hello!\n";
-  local $| = 1;
-  open my $fh, "<", \$buf or die $!;
-  my $fh2 = T_IN($fh);
-  is(readline($fh2), $buf);
-  local $SIG{__WARN__} = sub {die};
-  ok(not(eval {print $fh2 "foo\n"; 1}));
-}
-
-# T_OUT
-note("T_OUT");
-SCOPE: {
-  my $buf = '';
-  local $| = 1;
-  open my $fh, "+<", \$buf or die $!;
-  my $str = "Fooo!\n";
-  print $fh $str;
-  my $fh2 = T_OUT($fh);
-  seek($fh2, 0, 0);
-  is(readline($fh2), $str);
-  ok(eval {print $fh2 "foo\n"; 1});
-}
-
-sub is_approx {
-  my ($l, $r, $n) = @_;
-  if (not defined $l or not defined $r) {
-    fail(defined($n) ? $n : ());
-  }
-  else {
-    ok($l < $r+1e-6 && $r < $l+1e-6, defined($n) ? $n : ())
-      or note("$l and $r seem to be different given a fuzz of 1e-6");
-  }
-}
diff --git a/gnu/usr.bin/perl/ext/mro/mro.pm b/gnu/usr.bin/perl/ext/mro/mro.pm
index 1dddd6180fa..5a193e2c8c8 100644
--- a/gnu/usr.bin/perl/ext/mro/mro.pm
+++ b/gnu/usr.bin/perl/ext/mro/mro.pm
@@ -1,7 +1,7 @@
 #      mro.pm
 #
 #      Copyright (c) 2007 Brandon L Black
-#      Copyright (c) 2008,2009 Larry Wall and others
+#      Copyright (c) 2008 Larry Wall and others
 #
 #      You may distribute under the terms of either the GNU General Public
 #      License or the Artistic License, as specified in the README file.
@@ -12,7 +12,7 @@ use warnings;
 
 # mro.pm versions < 1.00 reserved for MRO::Compat
 #  for partial back-compat to 5.[68].x
-our $VERSION = '1.16';
+our $VERSION = '1.01';
 
 sub import {
     mro::set_mro(scalar(caller), $_[1]) if $_[1];
@@ -38,7 +38,7 @@ sub method {
 }
 
 require XSLoader;
-XSLoader::load('mro');
+XSLoader::load('mro', $VERSION);
 
 1;
 
@@ -94,7 +94,7 @@ as well.
 
 =head2 How does C3 work
 
-C3 works by always preserving local precedence ordering. This essentially
+C3 works by always preserving local precendence ordering. This essentially
 means that no class will appear before any of its subclasses. Take, for
 instance, the classic diamond inheritance pattern:
 
@@ -131,7 +131,7 @@ Note that C<UNIVERSAL> (and any members of C<UNIVERSAL>'s MRO) are not
 part of the MRO of a class, even though all classes implicitly inherit
 methods from C<UNIVERSAL> and its parents.
 
-=head2 mro::set_mro ($classname, $type)
+=head2 mro::set_mro($classname, $type)
 
 Sets the MRO of the given class to the C<$type> argument (either
 C<c3> or C<dfs>).
@@ -148,7 +148,19 @@ the given class name, even if the isa relationship is
 indirect.  This is used internally by the MRO code to
 keep track of method/MRO cache invalidations.
 
-As with C<mro::get_linear_isa> above, C<UNIVERSAL> is special.
+Currently, this list only grows, it never shrinks.  This
+was a performance consideration (properly tracking and
+deleting isarev entries when someone removes an entry
+from an C<@ISA> is costly, and it doesn't happen often
+anyways).  The fact that a class which no longer truly
+"isa" this class at runtime remains on the list should be
+considered a quirky implementation detail which is subject
+to future change.  It shouldn't be an issue as long as
+you're looking at this list for the same reasons the
+core code does: as a performance optimization
+over having to search every class in existence.
+
+As with C<mro::get_mro> above, C<UNIVERSAL> is special.
 C<UNIVERSAL> (and parents') isarev lists do not include
 every class in existence, even though all classes are
 effectively descendants for method inheritance purposes.
@@ -163,6 +175,10 @@ Any class for which this function returns true is
 "universal" in the sense that all classes potentially
 inherit methods from it.
 
+For similar reasons to C<isarev> above, this flag is
+permanent.  Once it is set, it does not go away, even
+if the class in question really isn't universal anymore.
+
 =head2 mro::invalidate_all_method_caches()
 
 Increments C<PL_sub_generation>, which invalidates method
@@ -202,10 +218,10 @@ This integer normally starts off at a value of C<1>
 when a package stash is instantiated.  Calling it
 on packages whose stashes do not exist at all will
 return C<0>.  If a package stash is completely
-deleted (not a normal occurrence, but it can happen
+deleted (not a normal occurence, but it can happen
 if someone does something like C<undef %PkgName::>),
 the number will be reset to either C<0> or C<1>,
-depending on how completely the package was wiped out.
+depending on how completely package was wiped out.
 
 =head2 next::method
 
@@ -308,20 +324,24 @@ works (like C<goto &maybe::next::method>);
 
 =over 4
 
-=item L<http://haahr.tempdomainname.com/dylan/linearization-oopsla96.html>
+=item L<http://www.webcom.com/haahr/dylan/linearization-oopsla96.html>
 
 =back
 
-=head2 Pugs
+=head2 The prototype Perl 6 Object Model uses C3
 
-The Pugs prototype Perl 6 Object Model uses C3
+=over 4
 
-=head2 Parrot
+=item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel/>
 
-Parrot now uses C3
+=back
+
+=head2 Parrot now uses C3
 
 =over 4
 
+=item L<http://aspn.activestate.com/ASPN/Mail/Message/perl6-internals/2746631>
+
 =item L<http://use.perl.org/~autrijus/journal/25768>
 
 =back
@@ -336,6 +356,14 @@ Parrot now uses C3
 
 =back
 
+=head2 C3 for TinyCLOS
+
+=over 4
+
+=item L<http://www.call-with-current-continuation.org/eggs/c3.html>
+
+=back 
+
 =head2 Class::C3
 
 =over 4
diff --git a/gnu/usr.bin/perl/ext/mro/mro.xs b/gnu/usr.bin/perl/ext/mro/mro.xs
index fead95f759b..74fce997cb8 100644
--- a/gnu/usr.bin/perl/ext/mro/mro.xs
+++ b/gnu/usr.bin/perl/ext/mro/mro.xs
@@ -1,5 +1,3 @@
-#define PERL_NO_GET_CONTEXT
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -39,15 +37,13 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
 
     assert(HvAUX(stash));
 
-    stashhek = HvENAME_HEK(stash);
-    if (!stashhek) stashhek = HvNAME_HEK(stash);
+    stashhek = HvNAME_HEK(stash);
     if (!stashhek)
       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
 
     if (level > 100)
-        Perl_croak(aTHX_ "Recursive inheritance detected in package '%"HEKf
-                         "'",
-                          HEKfARG(stashhek));
+        Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
+		   HEK_KEY(stashhek));
 
     meta = HvMROMETA(stash);
 
@@ -70,7 +66,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
     if(isa && AvFILLp(isa) >= 0) {
         SV** seqs_ptr;
         I32 seqs_items;
-        HV *tails;
+        HV* const tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
         AV *const seqs = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
         I32* heads;
 
@@ -78,12 +74,11 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
            The members of @seqs are the MROs of
            the members of @ISA, followed by @ISA itself.
         */
-        SSize_t items = AvFILLp(isa) + 1;
+        I32 items = AvFILLp(isa) + 1;
         SV** isa_ptr = AvARRAY(isa);
         while(items--) {
-            SV* const isa_item = *isa_ptr ? *isa_ptr : &PL_sv_undef;
+            SV* const isa_item = *isa_ptr++;
             HV* const isa_item_stash = gv_stashsv(isa_item, 0);
-            isa_ptr++;
             if(!isa_item_stash) {
                 /* if no stash, make a temporary fake MRO
                    containing just itself */
@@ -95,49 +90,10 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
                 /* recursion */
                 AV* const isa_lin
 		  = S_mro_get_linear_isa_c3(aTHX_ isa_item_stash, level + 1);
-
-		if(items == 0 && AvFILLp(seqs) == -1) {
-		    /* Only one parent class. For this case, the C3
-		       linearisation is this class followed by the parent's
-		       linearisation, so don't bother with the expensive
-		       calculation.  */
-		    SV **svp;
-		    I32 subrv_items = AvFILLp(isa_lin) + 1;
-		    SV *const *subrv_p = AvARRAY(isa_lin);
-
-		    /* Hijack the allocated but unused array seqs to be the
-		       return value. It's currently mortalised.  */
-
-		    retval = seqs;
-
-		    av_extend(retval, subrv_items);
-		    AvFILLp(retval) = subrv_items;
-		    svp = AvARRAY(retval);
-
-		    /* First entry is this class.  We happen to make a shared
-		       hash key scalar because it's the cheapest and fastest
-		       way to do it.  */
-		    *svp++ = newSVhek(stashhek);
-
-		    while(subrv_items--) {
-			/* These values are unlikely to be shared hash key
-			   scalars, so no point in adding code to optimising
-			   for a case that is unlikely to be true.
-			   (Or prove me wrong and do it.)  */
-
-			SV *const val = *subrv_p++;
-			*svp++ = newSVsv(val);
-		    }
-
-		    SvREFCNT_inc(retval);
-
-		    goto done;
-		}
                 av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa_lin)));
             }
         }
         av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa)));
-	tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
 
         /* This builds "heads", which as an array of integer array
            indices, one per seq, which point at the virtual "head"
@@ -163,15 +119,9 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
                     HE* const he = hv_fetch_ent(tails, seqitem, 1, 0);
                     if(he) {
                         SV* const val = HeVAL(he);
-                        /* For 5.8.0 and later, sv_inc() with increment undef to
-			   an IV of 1, which is what we want for a newly created
-			   entry.  However, for 5.6.x it will become an NV of
-			   1.0, which confuses the SvIVX() checks above.  */
-			if(SvIOK(val)) {
-			    SvIV_set(val, SvIVX(val) + 1);
-			} else {
-			    sv_setiv(val, 1);
-			}
+			/* This will increment undef to 1, which is what we
+			   want for a newly created entry.  */
+                        sv_inc(val);
                     }
                 }
             }
@@ -252,25 +202,13 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
             /* If we had candidates, but nobody won, then the @ISA
                hierarchy is not C3-incompatible */
             if(!winner) {
-                SV *errmsg;
-                I32 i;
-
-                errmsg = newSVpvf(
-                           "Inconsistent hierarchy during C3 merge of class '%"HEKf"':\n\t"
-                            "current merge results [\n",
-                            HEKfARG(stashhek));
-                for (i = 0; i <= av_tindex(retval); i++) {
-                    SV **elem = av_fetch(retval, i, 0);
-                    sv_catpvf(errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
-                }
-                sv_catpvf(errmsg, "\t]\n\tmerging failed on '%"SVf"'", SVfARG(cand));
-
                 /* we have to do some cleanup before we croak */
 
                 SvREFCNT_dec(retval);
                 Safefree(heads);
 
-                Perl_croak(aTHX_ "%"SVf, SVfARG(errmsg));
+                Perl_croak(aTHX_ "Inconsistent hierarchy during C3 merge of class '%s': "
+                    "merging failed on parent '%"SVf"'", HEK_KEY(stashhek), SVfARG(cand));
             }
         }
     }
@@ -280,7 +218,6 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
         av_push(retval, newSVhek(stashhek));
     }
 
- done:
     /* we don't want anyone modifying the cache entry but us,
        and we do so by replacing it completely */
     SvREADONLY_on(retval);
@@ -304,182 +241,20 @@ __dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
     return i;
 }
 
-MODULE = mro		PACKAGE = mro		PREFIX = mro_
-
-void
-mro_get_linear_isa(...)
-  PROTOTYPE: $;$
-  PREINIT:
-    AV* RETVAL;
-    HV* class_stash;
-    SV* classname;
-  PPCODE:
-    if(items < 1 || items > 2)
-	croak_xs_usage(cv, "classname [, type ]");
-
-    classname = ST(0);
-    class_stash = gv_stashsv(classname, 0);
-
-    if(!class_stash) {
-        /* No stash exists yet, give them just the classname */
-        AV* isalin = newAV();
-        av_push(isalin, newSVsv(classname));
-        ST(0) = sv_2mortal(newRV_noinc(MUTABLE_SV(isalin)));
-        XSRETURN(1);
-    }
-    else if(items > 1) {
-	const struct mro_alg *const algo = Perl_mro_get_from_name(aTHX_ ST(1));
-	if (!algo)
-	    Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1));
-	RETVAL = algo->resolve(aTHX_ class_stash, 0);
-    }
-    else {
-        RETVAL = mro_get_linear_isa(class_stash);
-    }
-    ST(0) = newRV_inc(MUTABLE_SV(RETVAL));
-    sv_2mortal(ST(0));
-    XSRETURN(1);
-
-void
-mro_set_mro(...)
-  PROTOTYPE: $$
-  PREINIT:
-    SV* classname;
-    HV* class_stash;
-    struct mro_meta* meta;
-  PPCODE:
-    if (items != 2)
-	croak_xs_usage(cv, "classname, type");
-
-    classname = ST(0);
-    class_stash = gv_stashsv(classname, GV_ADD);
-    if(!class_stash) Perl_croak(aTHX_ "Cannot create class: '%"SVf"'!", SVfARG(classname));
-    meta = HvMROMETA(class_stash);
-
-    Perl_mro_set_mro(aTHX_ meta, ST(1));
-
-    XSRETURN_EMPTY;
-
-void
-mro_get_mro(...)
-  PROTOTYPE: $
-  PREINIT:
-    SV* classname;
-    HV* class_stash;
-  PPCODE:
-    if (items != 1)
-	croak_xs_usage(cv, "classname");
-
-    classname = ST(0);
-    class_stash = gv_stashsv(classname, 0);
-
-    if (class_stash) {
-        const struct mro_alg *const meta = HvMROMETA(class_stash)->mro_which;
- 	ST(0) = newSVpvn_flags(meta->name, meta->length,
-			       SVs_TEMP
-			       | ((meta->kflags & HVhek_UTF8) ? SVf_UTF8 : 0));
-    } else {
-      ST(0) = newSVpvn_flags("dfs", 3, SVs_TEMP);
-    }
-    XSRETURN(1);
-
-void
-mro_get_isarev(...)
-  PROTOTYPE: $
-  PREINIT:
-    SV* classname;
-    HE* he;
-    HV* isarev;
-    AV* ret_array;
-  PPCODE:
-    if (items != 1)
-	croak_xs_usage(cv, "classname");
-
-    classname = ST(0);
-
-    he = hv_fetch_ent(PL_isarev, classname, 0, 0);
-    isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
-
-    ret_array = newAV();
-    if(isarev) {
-        HE* iter;
-        hv_iterinit(isarev);
-        while((iter = hv_iternext(isarev)))
-            av_push(ret_array, newSVsv(hv_iterkeysv(iter)));
-    }
-    mXPUSHs(newRV_noinc(MUTABLE_SV(ret_array)));
-
-    PUTBACK;
+MODULE = mro		PACKAGE = mro		PREFIX = mro
 
 void
-mro_is_universal(...)
-  PROTOTYPE: $
-  PREINIT:
-    SV* classname;
-    HV* isarev;
-    char* classname_pv;
-    STRLEN classname_len;
-    HE* he;
-  PPCODE:
-    if (items != 1)
-	croak_xs_usage(cv, "classname");
-
-    classname = ST(0);
-
-    classname_pv = SvPV(classname,classname_len);
-
-    he = hv_fetch_ent(PL_isarev, classname, 0, 0);
-    isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
-
-    if((classname_len == 9 && strEQ(classname_pv, "UNIVERSAL"))
-        || (isarev && hv_exists(isarev, "UNIVERSAL", 9)))
-        XSRETURN_YES;
-    else
-        XSRETURN_NO;
-
-
-void
-mro_invalidate_all_method_caches(...)
-  PROTOTYPE: 
-  PPCODE:
-    if (items != 0)
-	croak_xs_usage(cv, "");
-
-    PL_sub_generation++;
-
-    XSRETURN_EMPTY;
-
-void
-mro_get_pkg_gen(...)
-  PROTOTYPE: $
-  PREINIT:
-    SV* classname;
-    HV* class_stash;
-  PPCODE:
-    if(items != 1)
-	croak_xs_usage(cv, "classname");
-    
-    classname = ST(0);
-
-    class_stash = gv_stashsv(classname, 0);
-
-    mXPUSHi(class_stash ? HvMROMETA(class_stash)->pkg_gen : 0);
-    
-    PUTBACK;
-
-void
-mro__nextcan(...)
+mro_nextcan(...)
   PREINIT:
     SV* self = ST(0);
     const I32 throw_nomethod = SvIVX(ST(1));
-    I32 cxix = cxstack_ix;
-    const PERL_CONTEXT *ccstack = cxstack;
+    register I32 cxix = cxstack_ix;
+    register const PERL_CONTEXT *ccstack = cxstack;
     const PERL_SI *top_si = PL_curstackinfo;
     HV* selfstash;
     SV *stashname;
     const char *fq_subname;
     const char *subname;
-    bool subname_utf8 = 0;
     STRLEN stashname_len;
     STRLEN subname_len;
     SV* sv;
@@ -547,20 +322,14 @@ mro__nextcan(...)
             }
 
             /* we found a real sub here */
-            sv = sv_newmortal();
+            sv = sv_2mortal(newSV(0));
 
             gv_efullname3(sv, cvgv, NULL);
 
-	    if(SvPOK(sv)) {
-		fq_subname = SvPVX(sv);
-		fq_subname_len = SvCUR(sv);
-
-                subname_utf8 = SvUTF8(sv) ? 1 : 0;
-		subname = strrchr(fq_subname, ':');
-	    } else {
-		subname = NULL;
-	    }
+            fq_subname = SvPVX(sv);
+            fq_subname_len = SvCUR(sv);
 
+            subname = strrchr(fq_subname, ':');
             if(!subname)
                 Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
 
@@ -589,11 +358,7 @@ mro__nextcan(...)
 	    SV* const val = HeVAL(cache_entry);
 	    if(val == &PL_sv_undef) {
 		if(throw_nomethod)
-		    Perl_croak(aTHX_
-                       "No next::method '%"SVf"' found for %"HEKf,
-                        SVfARG(newSVpvn_flags(subname, subname_len,
-                                SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
-                        HEKfARG( HvNAME_HEK(selfstash) ));
+		    Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
                 XSRETURN_EMPTY;
 	    }
 	    mXPUSHs(newRV_inc(val));
@@ -604,8 +369,7 @@ mro__nextcan(...)
     /* beyond here is just for cache misses, so perf isn't as critical */
 
     stashname_len = subname - fq_subname - 2;
-    stashname = newSVpvn_flags(fq_subname, stashname_len,
-                                SVs_TEMP | (subname_utf8 ? SVf_UTF8 : 0));
+    stashname = newSVpvn_flags(fq_subname, stashname_len, SVs_TEMP);
 
     /* has ourselves at the top of the list */
     linear_av = S_mro_get_linear_isa_c3(aTHX_ selfstash, 0);
@@ -637,44 +401,37 @@ mro__nextcan(...)
 
             if (!curstash) {
                 if (ckWARN(WARN_SYNTAX))
-                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                       "Can't locate package %"SVf" for @%"HEKf"::ISA",
-                        (void*)linear_sv,
-                        HEKfARG( HvNAME_HEK(selfstash) ));
+                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
+                        (void*)linear_sv, hvname);
                 continue;
             }
 
             assert(curstash);
 
-            gvp = (GV**)hv_fetch(curstash, subname,
-                                    subname_utf8 ? -(I32)subname_len : (I32)subname_len, 0);
+            gvp = (GV**)hv_fetch(curstash, subname, subname_len, 0);
             if (!gvp) continue;
 
             candidate = *gvp;
             assert(candidate);
 
             if (SvTYPE(candidate) != SVt_PVGV)
-                gv_init_pvn(candidate, curstash, subname, subname_len,
-                                GV_ADDMULTI|(subname_utf8 ? SVf_UTF8 : 0));
+                gv_init(candidate, curstash, subname, subname_len, TRUE);
 
             /* Notably, we only look for real entries, not method cache
                entries, because in C3 the method cache of a parent is not
                valid for the child */
             if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
                 SvREFCNT_inc_simple_void_NN(MUTABLE_SV(cand_cv));
-                (void)hv_store_ent(nmcache, sv, MUTABLE_SV(cand_cv), 0);
+                (void)hv_store_ent(nmcache, newSVsv(sv), MUTABLE_SV(cand_cv), 0);
                 mXPUSHs(newRV_inc(MUTABLE_SV(cand_cv)));
                 XSRETURN(1);
             }
         }
     }
 
-    (void)hv_store_ent(nmcache, sv, &PL_sv_undef, 0);
+    (void)hv_store_ent(nmcache, newSVsv(sv), &PL_sv_undef, 0);
     if(throw_nomethod)
-        Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"HEKf,
-                         SVfARG(newSVpvn_flags(subname, subname_len,
-                                SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
-                        HEKfARG( HvNAME_HEK(selfstash) ));
+        Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
     XSRETURN_EMPTY;
 
 BOOT: