Make dquote_static.c available to ext/re/

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index 1190e97..e3e91cf 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -392,20 +392,20 @@ XS(XS_UNIVERSAL_VERSION)
            if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
                Perl_croak(aTHX_ "%s version %"SVf" required--"
                       "this is only version %"SVf"", HvNAME_get(pkg),
-                      SVfARG(vnormal(req)),
-                      SVfARG(vnormal(sv)));
+                      SVfARG(sv_2mortal(vnormal(req))),
+                      SVfARG(sv_2mortal(vnormal(sv))));
            } else {
                Perl_croak(aTHX_ "%s version %"SVf" required--"
                       "this is only version %"SVf"", HvNAME_get(pkg),
-                      SVfARG(vstringify(req)),
-                      SVfARG(vstringify(sv)));
+                      SVfARG(sv_2mortal(vstringify(req))),
+                      SVfARG(sv_2mortal(vstringify(sv))));
            }
        }
 
     }
 
     if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
-       ST(0) = vstringify(sv);
+       ST(0) = sv_2mortal(vstringify(sv));
     } else {
        ST(0) = sv;
     }
@@ -456,10 +456,10 @@ XS(XS_version_stringify)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -479,10 +479,10 @@ XS(XS_version_numify)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -502,10 +502,10 @@ XS(XS_version_normal)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -525,10 +525,10 @@ XS(XS_version_vcmp)
         croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-         SV *  lobj;
+         SV *  lobj = ST(0);
 
-         if (sv_derived_from(ST(0), "version")) {
-              lobj = SvRV(ST(0));
+         if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
+              lobj = SvRV(lobj);
          }
          else
               Perl_croak(aTHX_ "lobj is not of type version");
@@ -541,7 +541,8 @@ XS(XS_version_vcmp)
 
               if ( ! sv_derived_from(robj, "version") )
               {
-                   robj = new_version(SvOK(robj) ? robj : newSVpvs("0"));
+                   robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
+                   sv_2mortal(robj);
               }
               rvs = SvRV(robj);
 
@@ -569,7 +570,7 @@ XS(XS_version_boolean)
     if (items < 1)
        croak_xs_usage(cv, "lobj, ...");
     SP -= items;
-    if (sv_derived_from(ST(0), "version")) {
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
        SV * const lobj = SvRV(ST(0));
        SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
        mPUSHs(rs);
@@ -586,7 +587,7 @@ XS(XS_version_noop)
     dXSARGS;
     if (items < 1)
        croak_xs_usage(cv, "lobj, ...");
-    if (sv_derived_from(ST(0), "version"))
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0)))
        Perl_croak(aTHX_ "operation not supported with version object");
     else
        Perl_croak(aTHX_ "lobj is not of type version");
@@ -602,7 +603,7 @@ XS(XS_version_is_alpha)
     if (items != 1)
        croak_xs_usage(cv, "lobj");
     SP -= items;
-    if (sv_derived_from(ST(0), "version")) {
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
        SV * const lobj = ST(0);
        if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
            XSRETURN_YES;
@@ -656,7 +657,7 @@ XS(XS_version_is_qv)
     if (items != 1)
        croak_xs_usage(cv, "lobj");
     SP -= items;
-    if (sv_derived_from(ST(0), "version")) {
+    if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
        SV * const lobj = ST(0);
        if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
            XSRETURN_YES;
@@ -793,9 +794,16 @@ XS(XS_Internals_SvREADONLY)        /* This is dangerous stuff. */
 {
     dVAR;
     dXSARGS;
-    SV * const sv = SvRV(ST(0));
+    SV * const svz = ST(0);
+    SV * sv;
     PERL_UNUSED_ARG(cv);
 
+    /* [perl #77776] - called as &foo() not foo() */
+    if (!SvROK(svz))
+        croak_xs_usage(cv, "SCALAR[, ON]");
+
+    sv = SvRV(svz);
+
     if (items == 1) {
         if (SvREADONLY(sv))
             XSRETURN_YES;
@@ -820,9 +828,16 @@ XS(XS_Internals_SvREFCNT)  /* This is dangerous stuff. */
 {
     dVAR;
     dXSARGS;
-    SV * const sv = SvRV(ST(0));
+    SV * const svz = ST(0);
+    SV * sv;
     PERL_UNUSED_ARG(cv);
 
+    /* [perl #77776] - called as &foo() not foo() */
+    if (!SvROK(svz))
+        croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
+
+    sv = SvRV(svz);
+
     if (items == 1)
         XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
     else if (items == 2) {
@@ -838,7 +853,7 @@ XS(XS_Internals_hv_clear_placehold)
     dVAR;
     dXSARGS;
 
-    if (items != 1)
+    if (items != 1 || !SvROK(ST(0)))
        croak_xs_usage(cv, "hv");
     else {
        HV * const hv = MUTABLE_HV(SvRV(ST(0)));
@@ -1174,19 +1189,29 @@ XS(XS_re_regexp_pattern)
     {
         /* Houston, we have a regex! */
         SV *pattern;
-        STRLEN left = 0;
-        char reflags[sizeof(INT_PAT_MODS)];
 
         if ( GIMME_V == G_ARRAY ) {
+           STRLEN left = 0;
+           char reflags[sizeof(INT_PAT_MODS) + 1]; /* The +1 is for the charset
+                                                       modifier */
+            const char *fptr;
+            char ch;
+            U16 match_flags;
+
             /*
                we are in list context so stringify
                the modifiers that apply. We ignore "negative
                modifiers" in this scenario.
             */
 
-            const char *fptr = INT_PAT_MODS;
-            char ch;
-            U16 match_flags = (U16)((RX_EXTFLAGS(re) & PMf_COMPILETIME)
+            if (RX_EXTFLAGS(re) & RXf_PMf_LOCALE) {
+               reflags[left++] = LOCALE_PAT_MOD;
+           }
+           else if (RX_EXTFLAGS(re) & RXf_PMf_UNICODE) {
+               reflags[left++] = UNICODE_PAT_MOD;
+           }
+            fptr = INT_PAT_MODS;
+            match_flags = (U16)((RX_EXTFLAGS(re) & PMf_COMPILETIME)
                                     >> RXf_PMf_STD_PMMOD_SHIFT);
 
             while((ch = *fptr++)) {
@@ -1256,7 +1281,7 @@ XS(XS_Tie_Hash_NamedCapture_FETCH)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(1), flags);
 
     SPAGAIN;
@@ -1290,7 +1315,7 @@ XS(XS_Tie_Hash_NamedCapture_STORE)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     CALLREG_NAMED_BUFF_STORE(rx,ST(1), ST(2), flags);
 }
 
@@ -1309,7 +1334,7 @@ XS(XS_Tie_Hash_NamedCapture_DELETE)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     CALLREG_NAMED_BUFF_DELETE(rx, ST(1), flags);
 }
 
@@ -1330,7 +1355,7 @@ XS(XS_Tie_Hash_NamedCapture_CLEAR)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     CALLREG_NAMED_BUFF_CLEAR(rx, flags);
 }
 
@@ -1352,7 +1377,7 @@ XS(XS_Tie_Hash_NamedCapture_EXISTS)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     ret = CALLREG_NAMED_BUFF_EXISTS(rx, ST(1), flags);
 
     SPAGAIN;
@@ -1380,7 +1405,7 @@ XS(XS_Tie_Hash_NamedCapture_FIRSTK)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     ret = CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags);
 
     SPAGAIN;
@@ -1412,7 +1437,7 @@ XS(XS_Tie_Hash_NamedCapture_NEXTK)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     ret = CALLREG_NAMED_BUFF_NEXTKEY(rx, ST(1), flags);
 
     SPAGAIN;
@@ -1443,7 +1468,7 @@ XS(XS_Tie_Hash_NamedCapture_SCALAR)
 
     SP -= items;
 
-    flags = (U32)INT2PTR(IV,SvIV(SvRV(MUTABLE_SV(ST(0)))));
+    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
     ret = CALLREG_NAMED_BUFF_SCALAR(rx, flags);
 
     SPAGAIN;