This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Silence empty if-statement warning.
[perl5.git] / universal.c
diff --git a/universal.c b/universal.c
index 39a724d..7bbcbdb 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -1,6 +1,7 @@
 /*    universal.c
  *
 /*    universal.c
  *
- *    Copyright (c) 1997-2003, Larry Wall
+ *    Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ *    2005, 2006, by 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.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -13,6 +14,10 @@
  * beginning." --Gandalf, relating Gollum's story
  */
 
  * beginning." --Gandalf, relating Gollum's story
  */
 
+/* This file contains the code that implements the functions in Perl's
+ * UNIVERSAL package, such as UNIVERSAL->can().
+ */
+
 #include "EXTERN.h"
 #define PERL_IN_UNIVERSAL_C
 #include "perl.h"
 #include "EXTERN.h"
 #define PERL_IN_UNIVERSAL_C
 #include "perl.h"
@@ -26,55 +31,65 @@
  * The main guts of traverse_isa was actually copied from gv_fetchmeth
  */
 
  * The main guts of traverse_isa was actually copied from gv_fetchmeth
  */
 
-STATIC SV *
-S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
+STATIC bool
+S_isa_lookup(pTHX_ HV *stash, const char *name, const HV* const name_stash,
              int len, int level)
 {
              int len, int level)
 {
+    dVAR;
     AV* av;
     GV* gv;
     GV** gvp;
     AV* av;
     GV* gv;
     GV** gvp;
-    HV* hv = Nullhv;
-    SV* subgen = Nullsv;
+    HV* hv = NULL;
+    SV* subgen = NULL;
+    const char *hvname;
 
     /* A stash/class can go by many names (ie. User == main::User), so 
        we compare the stash itself just in case */
 
     /* A stash/class can go by many names (ie. User == main::User), so 
        we compare the stash itself just in case */
-    if (name_stash && (stash == name_stash))
-        return &PL_sv_yes;
+    if (name_stash && ((const HV *)stash == name_stash))
+        return TRUE;
+
+    hvname = HvNAME_get(stash);
 
 
-    if (strEQ(HvNAME(stash), name))
-       return &PL_sv_yes;
+    if (strEQ(hvname, name))
+       return TRUE;
+
+    if (strEQ(name, "UNIVERSAL"))
+       return TRUE;
 
     if (level > 100)
        Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
 
     if (level > 100)
        Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
-                  HvNAME(stash));
+                  hvname);
 
 
-    gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
+    gvp = (GV**)hv_fetchs(stash, "::ISA::CACHE::", FALSE);
 
     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
        && (hv = GvHV(gv)))
     {
        if (SvIV(subgen) == (IV)PL_sub_generation) {
 
     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
        && (hv = GvHV(gv)))
     {
        if (SvIV(subgen) == (IV)PL_sub_generation) {
-           SV* sv;
-           SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
-           if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
-               DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
-                                 name, HvNAME(stash)) );
-               return sv;
+           SV** const svp = (SV**)hv_fetch(hv, name, len, FALSE);
+           if (svp) {
+               SV * const sv = *svp;
+#ifdef DEBUGGING
+               if (sv != &PL_sv_undef)
+                   DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
+                                   name, hvname) );
+#endif
+               return (sv == &PL_sv_yes);
            }
        }
        else {
            DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
            }
        }
        else {
            DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
-                             HvNAME(stash)) );
+                             hvname) );
            hv_clear(hv);
            sv_setiv(subgen, PL_sub_generation);
        }
     }
 
            hv_clear(hv);
            sv_setiv(subgen, PL_sub_generation);
        }
     }
 
-    gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
+    gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
 
     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
        if (!hv || !subgen) {
 
     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
        if (!hv || !subgen) {
-           gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
+           gvp = (GV**)hv_fetchs(stash, "::ISA::CACHE::", TRUE);
 
            gv = *gvp;
 
 
            gv = *gvp;
 
@@ -93,26 +108,24 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
            /* NOTE: No support for tied ISA */
            I32 items = AvFILLp(av) + 1;
            while (items--) {
            /* NOTE: No support for tied ISA */
            I32 items = AvFILLp(av) + 1;
            while (items--) {
-               SV* sv = *svp++;
-               HV* basestash = gv_stashsv(sv, FALSE);
+               SV* const sv = *svp++;
+               HV* const basestash = gv_stashsv(sv, FALSE);
                if (!basestash) {
                    if (ckWARN(WARN_MISC))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                if (!basestash) {
                    if (ckWARN(WARN_MISC))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                            "Can't locate package %"SVf" for @%s::ISA",
-                           sv, HvNAME(stash));
+                                   "Can't locate package %"SVf" for @%s::ISA",
+                                   (void*)sv, hvname);
                    continue;
                }
                    continue;
                }
-               if (&PL_sv_yes == isa_lookup(basestash, name, name_stash, 
-                                             len, level + 1)) {
+               if (isa_lookup(basestash, name, name_stash, len, level + 1)) {
                    (void)hv_store(hv,name,len,&PL_sv_yes,0);
                    (void)hv_store(hv,name,len,&PL_sv_yes,0);
-                   return &PL_sv_yes;
+                   return TRUE;
                }
            }
            (void)hv_store(hv,name,len,&PL_sv_no,0);
        }
     }
                }
            }
            (void)hv_store(hv,name,len,&PL_sv_no,0);
        }
     }
-
-    return boolSV(strEQ(name, "UNIVERSAL"));
+    return FALSE;
 }
 
 /*
 }
 
 /*
@@ -120,9 +133,9 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
 
 =for apidoc sv_derived_from
 
 
 =for apidoc sv_derived_from
 
-Returns a boolean indicating whether the SV is derived from the specified
-class.  This is the function that implements C<UNIVERSAL::isa>.  It works
-for class names as well as for objects.
+Returns a boolean indicating whether the SV is derived from the specified class
+I<at the C level>.  To check derivation at the Perl level, call C<isa()> as a
+normal Perl method.
 
 =cut
 */
 
 =cut
 */
@@ -130,46 +143,101 @@ for class names as well as for objects.
 bool
 Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
 {
 bool
 Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
 {
-    char *type;
+    dVAR;
     HV *stash;
     HV *stash;
-    HV *name_stash;
 
 
-    stash = Nullhv;
-    type = Nullch;
-
-    if (SvGMAGICAL(sv))
-        mg_get(sv) ;
+    SvGETMAGIC(sv);
 
     if (SvROK(sv)) {
 
     if (SvROK(sv)) {
+       const char *type;
         sv = SvRV(sv);
         type = sv_reftype(sv,0);
         sv = SvRV(sv);
         type = sv_reftype(sv,0);
-        if (SvOBJECT(sv))
-            stash = SvSTASH(sv);
+       if (type && strEQ(type,name))
+           return TRUE;
+       stash = SvOBJECT(sv) ? SvSTASH(sv) : NULL;
     }
     else {
         stash = gv_stashsv(sv, FALSE);
     }
 
     }
     else {
         stash = gv_stashsv(sv, FALSE);
     }
 
-    name_stash = gv_stashpv(name, FALSE);
+    if (stash) {
+       HV * const name_stash = gv_stashpv(name, FALSE);
+       return isa_lookup(stash, name, name_stash, strlen(name), 0);
+    }
+    else
+       return FALSE;
 
 
-    return (type && strEQ(type,name)) ||
-            (stash && isa_lookup(stash, name, name_stash, strlen(name), 0) 
-             == &PL_sv_yes)
-        ? TRUE
-        : FALSE ;
 }
 
 }
 
+/*
+=for apidoc sv_does
+
+Returns a boolean indicating whether the SV performs a specific, named role.
+The SV can be a Perl object or the name of a Perl class.
+
+=cut
+*/
+
 #include "XSUB.h"
 
 #include "XSUB.h"
 
-void XS_UNIVERSAL_isa(pTHX_ CV *cv);
-void XS_UNIVERSAL_can(pTHX_ CV *cv);
-void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
+bool
+Perl_sv_does(pTHX_ SV *sv, const char *name)
+{
+    const char *classname;
+    bool does_it;
+
+    dSP;
+    ENTER;
+    SAVETMPS;
+
+    SvGETMAGIC(sv);
+
+    if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
+               || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
+       return FALSE;
+
+    if (sv_isobject(sv)) {
+       classname = sv_reftype(SvRV(sv),TRUE);
+    } else {
+       classname = SvPV(sv,PL_na);
+    }
+
+    if (strEQ(name,classname))
+       return TRUE;
+
+    PUSHMARK(SP);
+    XPUSHs(sv);
+    XPUSHs(sv_2mortal(newSVpv(name, 0)));
+    PUTBACK;
+
+    call_method("isa", G_SCALAR);
+    SPAGAIN;
+
+    does_it = SvTRUE( TOPs );
+    FREETMPS;
+    LEAVE;
+
+    return does_it;
+}
+
+PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_DOES(pTHX_ CV *cv);
+PERL_XS_EXPORT_C void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
 XS(XS_version_new);
 XS(XS_version_stringify);
 XS(XS_version_numify);
 XS(XS_version_new);
 XS(XS_version_stringify);
 XS(XS_version_numify);
+XS(XS_version_normal);
 XS(XS_version_vcmp);
 XS(XS_version_boolean);
 XS(XS_version_vcmp);
 XS(XS_version_boolean);
+#ifdef HASATTRIBUTE_NORETURN
+XS(XS_version_noop) __attribute__noreturn__;
+#else
 XS(XS_version_noop);
 XS(XS_version_noop);
+#endif
+XS(XS_version_is_alpha);
+XS(XS_version_qv);
+XS(XS_utf8_is_utf8);
 XS(XS_utf8_valid);
 XS(XS_utf8_encode);
 XS(XS_utf8_decode);
 XS(XS_utf8_valid);
 XS(XS_utf8_encode);
 XS(XS_utf8_decode);
@@ -181,14 +249,21 @@ XS(XS_Internals_SvREADONLY);
 XS(XS_Internals_SvREFCNT);
 XS(XS_Internals_hv_clear_placehold);
 XS(XS_PerlIO_get_layers);
 XS(XS_Internals_SvREFCNT);
 XS(XS_Internals_hv_clear_placehold);
 XS(XS_PerlIO_get_layers);
+XS(XS_Regexp_DESTROY);
+XS(XS_Internals_hash_seed);
+XS(XS_Internals_rehash_seed);
+XS(XS_Internals_HvREHASH);
+XS(XS_Internals_inc_sub_generation);
 
 void
 Perl_boot_core_UNIVERSAL(pTHX)
 {
 
 void
 Perl_boot_core_UNIVERSAL(pTHX)
 {
-    char *file = __FILE__;
+    dVAR;
+    static const char file[] = __FILE__;
 
     newXS("UNIVERSAL::isa",             XS_UNIVERSAL_isa,         file);
     newXS("UNIVERSAL::can",             XS_UNIVERSAL_can,         file);
 
     newXS("UNIVERSAL::isa",             XS_UNIVERSAL_isa,         file);
     newXS("UNIVERSAL::can",             XS_UNIVERSAL_can,         file);
+    newXS("UNIVERSAL::DOES",            XS_UNIVERSAL_DOES,        file);
     newXS("UNIVERSAL::VERSION",        XS_UNIVERSAL_VERSION,     file);
     {
        /* register the overloading (type 'A') magic */
     newXS("UNIVERSAL::VERSION",        XS_UNIVERSAL_VERSION,     file);
     {
        /* register the overloading (type 'A') magic */
@@ -200,6 +275,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
        newXS("version::stringify", XS_version_stringify, file);
        newXS("version::(0+", XS_version_numify, file);
        newXS("version::numify", XS_version_numify, file);
        newXS("version::stringify", XS_version_stringify, file);
        newXS("version::(0+", XS_version_numify, file);
        newXS("version::numify", XS_version_numify, file);
+       newXS("version::normal", XS_version_normal, file);
        newXS("version::(cmp", XS_version_vcmp, file);
        newXS("version::(<=>", XS_version_vcmp, file);
        newXS("version::vcmp", XS_version_vcmp, file);
        newXS("version::(cmp", XS_version_vcmp, file);
        newXS("version::(<=>", XS_version_vcmp, file);
        newXS("version::vcmp", XS_version_vcmp, file);
@@ -207,7 +283,10 @@ Perl_boot_core_UNIVERSAL(pTHX)
        newXS("version::boolean", XS_version_boolean, file);
        newXS("version::(nomethod", XS_version_noop, file);
        newXS("version::noop", XS_version_noop, file);
        newXS("version::boolean", XS_version_boolean, file);
        newXS("version::(nomethod", XS_version_noop, file);
        newXS("version::noop", XS_version_noop, file);
+       newXS("version::is_alpha", XS_version_is_alpha, file);
+       newXS("version::qv", XS_version_qv, file);
     }
     }
+    newXS("utf8::is_utf8", XS_utf8_is_utf8, file);
     newXS("utf8::valid", XS_utf8_valid, file);
     newXS("utf8::encode", XS_utf8_encode, file);
     newXS("utf8::decode", XS_utf8_decode, file);
     newXS("utf8::valid", XS_utf8_valid, file);
     newXS("utf8::encode", XS_utf8_encode, file);
     newXS("utf8::decode", XS_utf8_decode, file);
@@ -221,56 +300,60 @@ Perl_boot_core_UNIVERSAL(pTHX)
                XS_Internals_hv_clear_placehold, file, "\\%");
     newXSproto("PerlIO::get_layers",
                XS_PerlIO_get_layers, file, "*;@");
                XS_Internals_hv_clear_placehold, file, "\\%");
     newXSproto("PerlIO::get_layers",
                XS_PerlIO_get_layers, file, "*;@");
+    newXS("Regexp::DESTROY", XS_Regexp_DESTROY, file);
+    newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
+    newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
+    newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
+    newXSproto("Internals::inc_sub_generation",XS_Internals_inc_sub_generation,
+              file, "");
 }
 
 
 XS(XS_UNIVERSAL_isa)
 {
 }
 
 
 XS(XS_UNIVERSAL_isa)
 {
+    dVAR;
     dXSARGS;
     dXSARGS;
-    SV *sv;
-    char *name;
-    STRLEN n_a;
 
     if (items != 2)
        Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)");
 
     if (items != 2)
        Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)");
+    else {
+       SV * const sv = ST(0);
+       const char *name;
 
 
-    sv = ST(0);
-
-    if (SvGMAGICAL(sv))
-       mg_get(sv);
+       SvGETMAGIC(sv);
 
 
-    if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
-               || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
-       XSRETURN_UNDEF;
+       if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
+                   || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
+           XSRETURN_UNDEF;
 
 
-    name = (char *)SvPV(ST(1),n_a);
+       name = SvPV_nolen_const(ST(1));
 
 
-    ST(0) = boolSV(sv_derived_from(sv, name));
-    XSRETURN(1);
+       ST(0) = boolSV(sv_derived_from(sv, name));
+       XSRETURN(1);
+    }
 }
 
 XS(XS_UNIVERSAL_can)
 {
 }
 
 XS(XS_UNIVERSAL_can)
 {
+    dVAR;
     dXSARGS;
     SV   *sv;
     dXSARGS;
     SV   *sv;
-    char *name;
+    const char *name;
     SV   *rv;
     HV   *pkg = NULL;
     SV   *rv;
     HV   *pkg = NULL;
-    STRLEN n_a;
 
     if (items != 2)
        Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)");
 
     sv = ST(0);
 
 
     if (items != 2)
        Perl_croak(aTHX_ "Usage: UNIVERSAL::can(object-ref, method)");
 
     sv = ST(0);
 
-    if (SvGMAGICAL(sv))
-       mg_get(sv);
+    SvGETMAGIC(sv);
 
     if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
                || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
        XSRETURN_UNDEF;
 
 
     if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
                || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
        XSRETURN_UNDEF;
 
-    name = (char *)SvPV(ST(1),n_a);
+    name = SvPV_nolen_const(ST(1));
     rv = &PL_sv_undef;
 
     if (SvROK(sv)) {
     rv = &PL_sv_undef;
 
     if (SvROK(sv)) {
@@ -283,7 +366,7 @@ XS(XS_UNIVERSAL_can)
     }
 
     if (pkg) {
     }
 
     if (pkg) {
-        GV *gv = gv_fetchmethod_autoload(pkg, name, FALSE);
+       GV * const gv = gv_fetchmethod_autoload(pkg, name, FALSE);
         if (gv && isGV(gv))
            rv = sv_2mortal(newRV((SV*)GvCV(gv)));
     }
         if (gv && isGV(gv))
            rv = sv_2mortal(newRV((SV*)GvCV(gv)));
     }
@@ -292,14 +375,34 @@ XS(XS_UNIVERSAL_can)
     XSRETURN(1);
 }
 
     XSRETURN(1);
 }
 
+XS(XS_UNIVERSAL_DOES)
+{
+    dVAR;
+    dXSARGS;
+
+    if (items != 2)
+       Perl_croak(aTHX_ "Usage: invocant->does(kind)");
+    else {
+       SV * const sv = ST(0);
+       const char *name;
+
+       name = SvPV_nolen_const(ST(1));
+       if (sv_does( sv, name ))
+           XSRETURN_YES;
+
+       XSRETURN_NO;
+    }
+}
+
 XS(XS_UNIVERSAL_VERSION)
 {
 XS(XS_UNIVERSAL_VERSION)
 {
+    dVAR;
     dXSARGS;
     HV *pkg;
     GV **gvp;
     GV *gv;
     SV *sv;
     dXSARGS;
     HV *pkg;
     GV **gvp;
     GV *gv;
     SV *sv;
-    char *undef;
+    const char *undef;
 
     if (SvROK(ST(0))) {
         sv = (SV*)SvRV(ST(0));
 
     if (SvROK(ST(0))) {
         sv = (SV*)SvRV(ST(0));
@@ -311,13 +414,15 @@ XS(XS_UNIVERSAL_VERSION)
         pkg = gv_stashsv(ST(0), FALSE);
     }
 
         pkg = gv_stashsv(ST(0), FALSE);
     }
 
-    gvp = pkg ? (GV**)hv_fetch(pkg,"VERSION",7,FALSE) : Null(GV**);
+    gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
 
 
-    if (gvp && isGV(gv = *gvp) && SvOK(sv = GvSV(gv))) {
-        SV *nsv = sv_newmortal();
+    if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
+        SV * const nsv = sv_newmortal();
         sv_setsv(nsv, sv);
         sv = nsv;
         sv_setsv(nsv, sv);
         sv = nsv;
-        undef = Nullch;
+       if ( !sv_derived_from(sv, "version"))
+           upg_version(sv);
+        undef = NULL;
     }
     else {
         sv = (SV*)&PL_sv_undef;
     }
     else {
         sv = (SV*)&PL_sv_undef;
@@ -325,54 +430,77 @@ XS(XS_UNIVERSAL_VERSION)
     }
 
     if (items > 1) {
     }
 
     if (items > 1) {
-       STRLEN len;
        SV *req = ST(1);
 
        if (undef) {
        SV *req = ST(1);
 
        if (undef) {
-            if (pkg)
-                 Perl_croak(aTHX_
-                            "%s does not define $%s::VERSION--version check failed",
-                            HvNAME(pkg), HvNAME(pkg));
-            else {
-                 char *str = SvPVx(ST(0), len);
-
-                 Perl_croak(aTHX_
-                            "%s defines neither package nor VERSION--version check failed", str);
+           if (pkg) {
+               const char * const name = HvNAME_get(pkg);
+               Perl_croak(aTHX_
+                          "%s does not define $%s::VERSION--version check failed",
+                          name, name);
+           } else {
+               Perl_croak(aTHX_
+                            "%s defines neither package nor VERSION--version check failed",
+                            SvPVx_nolen_const(ST(0)) );
             }
        }
             }
        }
-       if ( !sv_derived_from(sv, "version"))
-           sv = new_version(sv);
 
 
-       if ( !sv_derived_from(req, "version"))
-           req = new_version(req);
+       if ( !sv_derived_from(req, "version")) {
+           /* req may very well be R/O, so create a new object */
+           SV * const nsv = sv_newmortal();
+           sv_setsv(nsv, req);
+           req = nsv;
+           upg_version(req);
+       }
 
 
-       if ( vcmp( SvRV(req), SvRV(sv) ) > 0 )
-           Perl_croak(aTHX_
-               "%s version %"SVf" required--this is only version %"SVf,
-               HvNAME(pkg), req, sv);
+       if ( vcmp( req, sv ) > 0 )
+           Perl_croak(aTHX_ "%s version %"SVf" (%"SVf") required--"
+                      "this is only version %"SVf" (%"SVf")", HvNAME_get(pkg),
+                      (void*)vnumify(req),
+                      (void*)vnormal(req),
+                      (void*)vnumify(sv),
+                      (void*)vnormal(sv));
     }
 
     }
 
-    ST(0) = sv;
+    if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
+       ST(0) = vnumify(sv);
+    } else {
+       ST(0) = sv;
+    }
 
     XSRETURN(1);
 }
 
 XS(XS_version_new)
 {
 
     XSRETURN(1);
 }
 
 XS(XS_version_new)
 {
+    dVAR;
     dXSARGS;
     if (items > 3)
        Perl_croak(aTHX_ "Usage: version::new(class, version)");
     SP -= items;
     {
     dXSARGS;
     if (items > 3)
        Perl_croak(aTHX_ "Usage: version::new(class, version)");
     SP -= items;
     {
-/*     char *  class = (char *)SvPV_nolen(ST(0)); */
-        SV *version = ST(1);
-       if (items == 3 )
-       {
-           char *vs = savepvn(SvPVX(ST(2)),SvCUR(ST(2)));
-           version = Perl_newSVpvf(aTHX_ "v%s",vs);
+        SV *vs = ST(1);
+       SV *rv;
+       const char * const classname =
+           sv_isobject(ST(0)) /* get the class if called as an object method */
+               ? HvNAME(SvSTASH(SvRV(ST(0))))
+               : (char *)SvPV_nolen(ST(0));
+
+       if ( items == 1 || vs == &PL_sv_undef ) { /* no param or explicit undef */
+           /* create empty object */
+           vs = sv_newmortal();
+           sv_setpvn(vs,"",0);
        }
        }
+       else if ( items == 3 ) {
+           vs = sv_newmortal();
+           Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
+       }
+
+       rv = new_version(vs);
+       if ( strcmp(classname,"version") != 0 ) /* inherited new() */
+           sv_bless(rv, gv_stashpv(classname,TRUE));
 
 
-       PUSHs(new_version(version));
+       PUSHs(sv_2mortal(rv));
        PUTBACK;
        return;
     }
        PUTBACK;
        return;
     }
@@ -380,191 +508,261 @@ XS(XS_version_new)
 
 XS(XS_version_stringify)
 {
 
 XS(XS_version_stringify)
 {
-    dXSARGS;
-    if (items < 1)
-       Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
-    SP -= items;
-    {
-       SV *    lobj;
+     dVAR;
+     dXSARGS;
+     if (items < 1)
+         Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
+     SP -= items;
+     {
+         SV *  lobj;
+
+         if (sv_derived_from(ST(0), "version")) {
+              lobj = SvRV(ST(0));
+         }
+         else
+              Perl_croak(aTHX_ "lobj is not of type version");
+
+         PUSHs(sv_2mortal(vstringify(lobj)));
+
+         PUTBACK;
+         return;
+     }
+}
 
 
-        if (sv_derived_from(ST(0), "version")) {
-                SV *tmp = SvRV(ST(0));
-               lobj = tmp;
-        }
-        else
-                Perl_croak(aTHX_ "lobj is not of type version");
+XS(XS_version_numify)
+{
+     dVAR;
+     dXSARGS;
+     if (items < 1)
+         Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
+     SP -= items;
+     {
+         SV *  lobj;
+
+         if (sv_derived_from(ST(0), "version")) {
+              lobj = SvRV(ST(0));
+         }
+         else
+              Perl_croak(aTHX_ "lobj is not of type version");
+
+         PUSHs(sv_2mortal(vnumify(lobj)));
+
+         PUTBACK;
+         return;
+     }
+}
 
 
+XS(XS_version_normal)
 {
 {
-    PUSHs(vstringify(lobj));
+     dVAR;
+     dXSARGS;
+     if (items < 1)
+         Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)");
+     SP -= items;
+     {
+         SV *  lobj;
+
+         if (sv_derived_from(ST(0), "version")) {
+              lobj = SvRV(ST(0));
+         }
+         else
+              Perl_croak(aTHX_ "lobj is not of type version");
+
+         PUSHs(sv_2mortal(vnormal(lobj)));
+
+         PUTBACK;
+         return;
+     }
 }
 
 }
 
-       PUTBACK;
-       return;
-    }
+XS(XS_version_vcmp)
+{
+     dVAR;
+     dXSARGS;
+     if (items < 1)
+         Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
+     SP -= items;
+     {
+         SV *  lobj;
+
+         if (sv_derived_from(ST(0), "version")) {
+              lobj = SvRV(ST(0));
+         }
+         else
+              Perl_croak(aTHX_ "lobj is not of type version");
+
+         {
+              SV       *rs;
+              SV       *rvs;
+              SV * robj = ST(1);
+              const IV  swap = (IV)SvIV(ST(2));
+
+              if ( ! sv_derived_from(robj, "version") )
+              {
+                   robj = new_version(robj);
+              }
+              rvs = SvRV(robj);
+
+              if ( swap )
+              {
+                   rs = newSViv(vcmp(rvs,lobj));
+              }
+              else
+              {
+                   rs = newSViv(vcmp(lobj,rvs));
+              }
+
+              PUSHs(sv_2mortal(rs));
+         }
+
+         PUTBACK;
+         return;
+     }
 }
 
 }
 
-XS(XS_version_numify)
+XS(XS_version_boolean)
 {
 {
+    dVAR;
     dXSARGS;
     if (items < 1)
     dXSARGS;
     if (items < 1)
-       Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
+       Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
     SP -= items;
     SP -= items;
-    {
-       SV *    lobj;
-
-        if (sv_derived_from(ST(0), "version")) {
-                SV *tmp = SvRV(ST(0));
-               lobj = tmp;
-        }
-        else
-                Perl_croak(aTHX_ "lobj is not of type version");
-
-{
-    PUSHs(vnumify(lobj));
-}
-
+    if (sv_derived_from(ST(0), "version")) {
+       SV * const lobj = SvRV(ST(0));
+       SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
+       PUSHs(sv_2mortal(rs));
        PUTBACK;
        return;
     }
        PUTBACK;
        return;
     }
+    else
+       Perl_croak(aTHX_ "lobj is not of type version");
 }
 
 }
 
-XS(XS_version_vcmp)
+XS(XS_version_noop)
 {
 {
+    dVAR;
     dXSARGS;
     if (items < 1)
     dXSARGS;
     if (items < 1)
-       Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
-    SP -= items;
-    {
-       SV *    lobj;
-
-        if (sv_derived_from(ST(0), "version")) {
-                SV *tmp = SvRV(ST(0));
-               lobj = tmp;
-        }
-        else
-                Perl_croak(aTHX_ "lobj is not of type version");
-
-{
-    SV *rs;
-    SV *rvs;
-    SV * robj = ST(1);
-    IV  swap = (IV)SvIV(ST(2));
-
-    if ( ! sv_derived_from(robj, "version") )
-    {
-       robj = new_version(robj);
-    }
-    rvs = SvRV(robj);
-
-    if ( swap )
-    {
-        rs = newSViv(vcmp(rvs,lobj));
-    }
+       Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
+    if (sv_derived_from(ST(0), "version"))
+       Perl_croak(aTHX_ "operation not supported with version object");
     else
     else
-    {
-        rs = newSViv(vcmp(lobj,rvs));
-    }
-
-    PUSHs(rs);
+       Perl_croak(aTHX_ "lobj is not of type version");
+#ifndef HASATTRIBUTE_NORETURN
+    XSRETURN_EMPTY;
+#endif
 }
 
 }
 
+XS(XS_version_is_alpha)
+{
+    dVAR;
+    dXSARGS;
+    if (items != 1)
+       Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)");
+    SP -= items;
+    if (sv_derived_from(ST(0), "version")) {
+       SV * const lobj = ST(0);
+       if ( hv_exists((HV*)SvRV(lobj), "alpha", 5 ) )
+           XSRETURN_YES;
+       else
+           XSRETURN_NO;
        PUTBACK;
        return;
     }
        PUTBACK;
        return;
     }
+    else
+       Perl_croak(aTHX_ "lobj is not of type version");
 }
 
 }
 
-XS(XS_version_boolean)
+XS(XS_version_qv)
 {
 {
+    dVAR;
     dXSARGS;
     dXSARGS;
-    if (items < 1)
-       Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
+    if (items != 1)
+       Perl_croak(aTHX_ "Usage: version::qv(ver)");
     SP -= items;
     {
     SP -= items;
     {
-       SV *    lobj;
-
-        if (sv_derived_from(ST(0), "version")) {
-                SV *tmp = SvRV(ST(0));
-               lobj = tmp;
-        }
-        else
-                Perl_croak(aTHX_ "lobj is not of type version");
+       SV *    ver = ST(0);
+       if ( !SvVOK(ver) ) { /* only need to do with if not already v-string */
+           SV * const vs = sv_newmortal();
+           char *version;
+           if ( SvNOK(ver) ) /* may get too much accuracy */
+           {
+               char tbuf[64];
+               const STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVgf, SvNVX(ver));
+               version = savepvn(tbuf, len);
+           }
+           else
+           {
+               version = savesvpv(ver);
+           }
+           (void)scan_version(version,vs,TRUE);
+           Safefree(version);
 
 
-{
-    SV *rs;
-    rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) );
-    PUSHs(rs);
-}
+           PUSHs(vs);
+       }
+       else
+       {
+           PUSHs(sv_2mortal(new_version(ver)));
+       }
 
        PUTBACK;
        return;
     }
 }
 
 
        PUTBACK;
        return;
     }
 }
 
-XS(XS_version_noop)
+XS(XS_utf8_is_utf8)
 {
 {
-    dXSARGS;
-    if (items < 1)
-       Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
-    {
-       SV *    lobj;
-
-        if (sv_derived_from(ST(0), "version")) {
-                SV *tmp = SvRV(ST(0));
-               lobj = tmp;
-        }
-        else
-                Perl_croak(aTHX_ "lobj is not of type version");
-
-{
-    Perl_croak(aTHX_ "operation not supported with version object");
-}
-
-    }
-    XSRETURN_EMPTY;
+     dVAR;
+     dXSARGS;
+     if (items != 1)
+         Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)");
+     else {
+       const SV * const sv = ST(0);
+           if (SvUTF8(sv))
+               XSRETURN_YES;
+           else
+               XSRETURN_NO;
+     }
+     XSRETURN_EMPTY;
 }
 
 XS(XS_utf8_valid)
 {
 }
 
 XS(XS_utf8_valid)
 {
-    dXSARGS;
-    if (items != 1)
-       Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
-    {
-       SV *    sv = ST(0);
- {
-  STRLEN len;
-  char *s = SvPV(sv,len);
-  if (!SvUTF8(sv) || is_utf8_string((U8*)s,len))
-   XSRETURN_YES;
-  else
-   XSRETURN_NO;
- }
+     dVAR;
+     dXSARGS;
+     if (items != 1)
+         Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
+    else {
+       SV * const sv = ST(0);
+       STRLEN len;
+       const char * const s = SvPV_const(sv,len);
+       if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
+           XSRETURN_YES;
+       else
+           XSRETURN_NO;
     }
     }
-    XSRETURN_EMPTY;
+     XSRETURN_EMPTY;
 }
 
 XS(XS_utf8_encode)
 {
 }
 
 XS(XS_utf8_encode)
 {
+    dVAR;
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
-    {
-       SV *    sv = ST(0);
-
-       sv_utf8_encode(sv);
-    }
+    sv_utf8_encode(ST(0));
     XSRETURN_EMPTY;
 }
 
 XS(XS_utf8_decode)
 {
     XSRETURN_EMPTY;
 }
 
 XS(XS_utf8_decode)
 {
+    dVAR;
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
-    {
-       SV *    sv = ST(0);
-       bool    RETVAL;
-
-       RETVAL = sv_utf8_decode(sv);
+    else {
+       SV * const sv = ST(0);
+       const bool RETVAL = sv_utf8_decode(sv);
        ST(0) = boolSV(RETVAL);
        sv_2mortal(ST(0));
     }
        ST(0) = boolSV(RETVAL);
        sv_2mortal(ST(0));
     }
@@ -573,11 +771,12 @@ XS(XS_utf8_decode)
 
 XS(XS_utf8_upgrade)
 {
 
 XS(XS_utf8_upgrade)
 {
+    dVAR;
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
-    {
-       SV *    sv = ST(0);
+    else {
+       SV * const sv = ST(0);
        STRLEN  RETVAL;
        dXSTARG;
 
        STRLEN  RETVAL;
        dXSTARG;
 
@@ -589,21 +788,15 @@ XS(XS_utf8_upgrade)
 
 XS(XS_utf8_downgrade)
 {
 
 XS(XS_utf8_downgrade)
 {
+    dVAR;
     dXSARGS;
     if (items < 1 || items > 2)
        Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
     dXSARGS;
     if (items < 1 || items > 2)
        Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
-    {
-       SV *    sv = ST(0);
-       bool    failok;
-       bool    RETVAL;
-
-       if (items < 2)
-           failok = 0;
-       else {
-           failok = (int)SvIV(ST(1));
-       }
+    else {
+       SV * const sv = ST(0);
+        const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
+        const bool RETVAL = sv_utf8_downgrade(sv, failok);
 
 
-       RETVAL = sv_utf8_downgrade(sv, failok);
        ST(0) = boolSV(RETVAL);
        sv_2mortal(ST(0));
     }
        ST(0) = boolSV(RETVAL);
        sv_2mortal(ST(0));
     }
@@ -612,8 +805,9 @@ XS(XS_utf8_downgrade)
 
 XS(XS_utf8_native_to_unicode)
 {
 
 XS(XS_utf8_native_to_unicode)
 {
+ dVAR;
  dXSARGS;
  dXSARGS;
- UV uv = SvUV(ST(0));
+ const UV uv = SvUV(ST(0));
 
  if (items > 1)
      Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)");
 
  if (items > 1)
      Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)");
@@ -624,8 +818,9 @@ XS(XS_utf8_native_to_unicode)
 
 XS(XS_utf8_unicode_to_native)
 {
 
 XS(XS_utf8_unicode_to_native)
 {
+ dVAR;
  dXSARGS;
  dXSARGS;
- UV uv = SvUV(ST(0));
+ const UV uv = SvUV(ST(0));
 
  if (items > 1)
      Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)");
 
  if (items > 1)
      Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)");
@@ -636,8 +831,10 @@ XS(XS_utf8_unicode_to_native)
 
 XS(XS_Internals_SvREADONLY)    /* This is dangerous stuff. */
 {
 
 XS(XS_Internals_SvREADONLY)    /* This is dangerous stuff. */
 {
+    dVAR;
     dXSARGS;
     dXSARGS;
-    SV *sv = SvRV(ST(0));
+    SV * const sv = SvRV(ST(0));
+
     if (items == 1) {
         if (SvREADONLY(sv))
             XSRETURN_YES;
     if (items == 1) {
         if (SvREADONLY(sv))
             XSRETURN_YES;
@@ -660,8 +857,10 @@ XS(XS_Internals_SvREADONLY)        /* This is dangerous stuff. */
 
 XS(XS_Internals_SvREFCNT)      /* This is dangerous stuff. */
 {
 
 XS(XS_Internals_SvREFCNT)      /* This is dangerous stuff. */
 {
+    dVAR;
     dXSARGS;
     dXSARGS;
-    SV *sv = SvRV(ST(0));
+    SV * const sv = SvRV(ST(0));
+
     if (items == 1)
         XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
     else if (items == 2) {
     if (items == 1)
         XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
     else if (items == 2) {
@@ -672,58 +871,29 @@ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
     XSRETURN_UNDEF; /* Can't happen. */
 }
 
     XSRETURN_UNDEF; /* Can't happen. */
 }
 
-/* Maybe this should return the number of placeholders found in scalar context,
-   and a list of them in list context.  */
 XS(XS_Internals_hv_clear_placehold)
 {
 XS(XS_Internals_hv_clear_placehold)
 {
+    dVAR;
     dXSARGS;
     dXSARGS;
-    HV *hv = (HV *) SvRV(ST(0));
-
-    /* I don't care how many parameters were passed in, but I want to avoid
-       the unused variable warning. */
-
-    items = (I32)HvPLACEHOLDERS(hv);
-
-    if (items) {
-        HE *entry;
-        I32 riter = HvRITER(hv);
-        HE *eiter = HvEITER(hv);
-        hv_iterinit(hv);
-        /* This may look suboptimal with the items *after* the iternext, but
-           it's quite deliberate. We only get here with items==0 if we've
-           just deleted the last placeholder in the hash. If we've just done
-           that then it means that the hash is in lazy delete mode, and the
-           HE is now only referenced in our iterator. If we just quit the loop
-           and discarded our iterator then the HE leaks. So we do the && the
-           other way to ensure iternext is called just one more time, which
-           has the side effect of triggering the lazy delete.  */
-        while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
-            && items) {
-            SV *val = hv_iterval(hv, entry);
-
-            if (val == &PL_sv_undef) {
-
-                /* It seems that I have to go back in the front of the hash
-                   API to delete a hash, even though I have a HE structure
-                   pointing to the very entry I want to delete, and could hold
-                   onto the previous HE that points to it. And it's easier to
-                   go in with SVs as I can then specify the precomputed hash,
-                   and don't have fun and games with utf8 keys.  */
-                SV *key = hv_iterkeysv(entry);
-
-                hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry));
-                items--;
-            }
-        }
-        HvRITER(hv) = riter;
-        HvEITER(hv) = eiter;
+
+    if (items != 1)
+       Perl_croak(aTHX_ "Usage: UNIVERSAL::hv_clear_placeholders(hv)");
+    else {
+       HV * const hv = (HV *) SvRV(ST(0));
+       hv_clear_placeholders(hv);
+       XSRETURN(0);
     }
     }
+}
 
 
-    XSRETURN(0);
+XS(XS_Regexp_DESTROY)
+{
+    PERL_UNUSED_CONTEXT;
+    PERL_UNUSED_ARG(cv);
 }
 
 XS(XS_PerlIO_get_layers)
 {
 }
 
 XS(XS_PerlIO_get_layers)
 {
+    dVAR;
     dXSARGS;
     if (items < 1 || items % 2 == 0)
        Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])");
     dXSARGS;
     if (items < 1 || items % 2 == 0)
        Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])");
@@ -736,14 +906,12 @@ XS(XS_PerlIO_get_layers)
        bool    details = FALSE;
 
        if (items > 1) {
        bool    details = FALSE;
 
        if (items > 1) {
-            SV **popuntil = MARK + 1;
-            SV **svp;
-            
+            SV * const *svp;
             for (svp = MARK + 2; svp <= SP; svp += 2) {
             for (svp = MARK + 2; svp <= SP; svp += 2) {
-                 SV **varp = svp;
-                 SV **valp = svp + 1;
+                 SV * const * const varp = svp;
+                 SV * const * const valp = svp + 1;
                  STRLEN klen;
                  STRLEN klen;
-                 char *key = SvPV(*varp, klen);
+                 const char * const key = SvPV_const(*varp, klen);
 
                  switch (*key) {
                  case 'i':
 
                  switch (*key) {
                  case 'i':
@@ -781,37 +949,34 @@ XS(XS_PerlIO_get_layers)
        if (!isGV(sv)) {
             if (SvROK(sv) && isGV(SvRV(sv)))
                  gv = (GV*)SvRV(sv);
        if (!isGV(sv)) {
             if (SvROK(sv) && isGV(SvRV(sv)))
                  gv = (GV*)SvRV(sv);
-            else
-                 gv = gv_fetchpv(SvPVX(sv), FALSE, SVt_PVIO);
+            else if (SvPOKp(sv))
+                 gv = gv_fetchsv(sv, 0, SVt_PVIO);
        }
 
        if (gv && (io = GvIO(gv))) {
             dTARGET;
        }
 
        if (gv && (io = GvIO(gv))) {
             dTARGET;
-            AV* av = PerlIO_get_layers(aTHX_ input ?
+            AV* const av = PerlIO_get_layers(aTHX_ input ?
                                        IoIFP(io) : IoOFP(io));
             I32 i;
                                        IoIFP(io) : IoOFP(io));
             I32 i;
-            I32 last = av_len(av);
+            const I32 last = av_len(av);
             I32 nitem = 0;
             
             for (i = last; i >= 0; i -= 3) {
             I32 nitem = 0;
             
             for (i = last; i >= 0; i -= 3) {
-                 SV **namsvp;
-                 SV **argsvp;
-                 SV **flgsvp;
-                 bool namok, argok, flgok;
-
-                 namsvp = av_fetch(av, i - 2, FALSE);
-                 argsvp = av_fetch(av, i - 1, FALSE);
-                 flgsvp = av_fetch(av, i,     FALSE);
+                 SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
+                 SV * const * const argsvp = av_fetch(av, i - 1, FALSE);
+                 SV * const * const flgsvp = av_fetch(av, i,     FALSE);
 
 
-                 namok = namsvp && *namsvp && SvPOK(*namsvp);
-                 argok = argsvp && *argsvp && SvPOK(*argsvp);
-                 flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
+                 const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
+                 const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
+                 const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
 
                  if (details) {
 
                  if (details) {
-                      XPUSHs(namok ?
-                            newSVpv(SvPVX(*namsvp), 0) : &PL_sv_undef);
-                      XPUSHs(argok ?
-                            newSVpv(SvPVX(*argsvp), 0) : &PL_sv_undef);
+                      XPUSHs(namok
+                             ? newSVpvn(SvPVX_const(*namsvp), SvCUR(*namsvp))
+                             : &PL_sv_undef);
+                      XPUSHs(argok
+                             ? newSVpvn(SvPVX_const(*argsvp), SvCUR(*argsvp))
+                             : &PL_sv_undef);
                       if (flgok)
                            XPUSHi(SvIVX(*flgsvp));
                       else
                       if (flgok)
                            XPUSHi(SvIVX(*flgsvp));
                       else
@@ -821,17 +986,19 @@ XS(XS_PerlIO_get_layers)
                  else {
                       if (namok && argok)
                            XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
                  else {
                       if (namok && argok)
                            XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
-                                              *namsvp, *argsvp));
+                                                (void*)*namsvp,
+                                                (void*)*argsvp));
                       else if (namok)
                       else if (namok)
-                           XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf, *namsvp));
+                           XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf,
+                                                (void*)*namsvp));
                       else
                            XPUSHs(&PL_sv_undef);
                       nitem++;
                       if (flgok) {
                       else
                            XPUSHs(&PL_sv_undef);
                       nitem++;
                       if (flgok) {
-                           IV flags = SvIVX(*flgsvp);
+                           const IV flags = SvIVX(*flgsvp);
 
                            if (flags & PERLIO_F_UTF8) {
 
                            if (flags & PERLIO_F_UTF8) {
-                                XPUSHs(newSVpvn("utf8", 4));
+                                XPUSHs(newSVpvs("utf8"));
                                 nitem++;
                            }
                       }
                                 nitem++;
                            }
                       }
@@ -848,3 +1015,62 @@ XS(XS_PerlIO_get_layers)
     XSRETURN(0);
 }
 
     XSRETURN(0);
 }
 
+XS(XS_Internals_hash_seed)
+{
+    dVAR;
+    /* Using dXSARGS would also have dITEM and dSP,
+     * which define 2 unused local variables.  */
+    dAXMARK;
+    PERL_UNUSED_ARG(cv);
+    PERL_UNUSED_VAR(mark);
+    XSRETURN_UV(PERL_HASH_SEED);
+}
+
+XS(XS_Internals_rehash_seed)
+{
+    dVAR;
+    /* Using dXSARGS would also have dITEM and dSP,
+     * which define 2 unused local variables.  */
+    dAXMARK;
+    PERL_UNUSED_ARG(cv);
+    PERL_UNUSED_VAR(mark);
+    XSRETURN_UV(PL_rehash_seed);
+}
+
+XS(XS_Internals_HvREHASH)      /* Subject to change  */
+{
+    dVAR;
+    dXSARGS;
+    if (SvROK(ST(0))) {
+       const HV * const hv = (HV *) SvRV(ST(0));
+       if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
+           if (HvREHASH(hv))
+               XSRETURN_YES;
+           else
+               XSRETURN_NO;
+       }
+    }
+    Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
+}
+
+XS(XS_Internals_inc_sub_generation)
+{
+    dVAR;
+    /* Using dXSARGS would also have dITEM and dSP,
+     * which define 2 unused local variables.  */
+    dAXMARK;
+    PERL_UNUSED_ARG(cv);
+    PERL_UNUSED_VAR(mark);
+    ++PL_sub_generation;
+    XSRETURN_EMPTY;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
Unnamed repository; edit this file 'description' to name the repository.