This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add newSVpvs_flags() as a wrapper to newSVpvn_flags(), and rework
authorNicholas Clark <nick@ccl4.org>
Thu, 3 Jan 2008 17:42:27 +0000 (17:42 +0000)
committerNicholas Clark <nick@ccl4.org>
Thu, 3 Jan 2008 17:42:27 +0000 (17:42 +0000)
sv_2mortal(newSVpvs(...)) constructions to use it.

p4raw-id: //depot/perl@32819

12 files changed:
cop.h
handy.h
mg.c
pp.c
pp_ctl.c
pp_sys.c
sv.c
toke.c
universal.c
utf8.c
util.c
xsutils.c

diff --git a/cop.h b/cop.h
index 71397c3..39dc9cb 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -261,7 +261,7 @@ struct cop {
                PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE;            \
            (c)->cop_hints_hash                                         \
               = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash,      \
-                                       sv_2mortal(newSVpvs("$[")),     \
+                                       newSVpvs_flags("$[", SVs_TEMP), \
                                        sv_2mortal(newSViv(b)));        \
        }                                                               \
     } STMT_END
diff --git a/handy.h b/handy.h
index 255c149..d891513 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -244,6 +244,10 @@ typedef U64TYPE U64;
 =for apidoc Ama|SV*|newSVpvs|const char* s
 Like C<newSVpvn>, but takes a literal string instead of a string/length pair.
 
+=for apidoc Ama|SV*|newSVpvs_flags|const char* s|U32 flags
+Like C<newSVpvn_flags>, but takes a literal string instead of a string/length
+pair.
+
 =for apidoc Ama|SV*|newSVpvs_share|const char* s
 Like C<newSVpvn_share>, but takes a literal string instead of a string/length
 pair and omits the hash parameter.
@@ -286,6 +290,8 @@ and omits the hash parameter.
 
 /* STR_WITH_LEN() shortcuts */
 #define newSVpvs(str) Perl_newSVpvn(aTHX_ STR_WITH_LEN(str))
+#define newSVpvs_flags(str,flags)      \
+    Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(str), flags)
 #define newSVpvs_share(str) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(str), 0)
 #define sv_catpvs(sv, str) Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC)
 #define sv_setpvs(sv, str) Perl_sv_setpvn(aTHX_ sv, STR_WITH_LEN(str))
diff --git a/mg.c b/mg.c
index 3cd278c..ce5b99c 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2311,14 +2311,16 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
            tmp_he
                = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash, 
-                                        sv_2mortal(newSVpvs("open>")), tmp);
+                                        newSVpvs_flags("open>", SVs_TEMP),
+                                        tmp);
 
            /* The UTF-8 setting is carried over  */
            sv_setpvn(tmp, start, out ? (STRLEN)(out - start) : len);
 
            PL_compiling.cop_hints_hash
                = Perl_refcounted_he_new(aTHX_ tmp_he,
-                                        sv_2mortal(newSVpvs("open<")), tmp);
+                                        newSVpvs_flags("open<", SVs_TEMP),
+                                        tmp);
        }
        break;
     case '\020':       /* ^P */
diff --git a/pp.c b/pp.c
index d25a55c..7e5cef3 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -413,7 +413,7 @@ PP(pp_prototype)
                        || code == -KEY_exec || code == -KEY_system)
                    goto set;
                if (code == -KEY_mkdir) {
-                   ret = sv_2mortal(newSVpvs("_;$"));
+                   ret = newSVpvs_flags("_;$", SVs_TEMP);
                    goto set;
                }
                if (code == -KEY_readpipe) {
index 8681cd9..e1ad0e9 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1643,12 +1643,12 @@ PP(pp_caller)
            PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
        }
        else {
-           PUSHs(sv_2mortal(newSVpvs("(unknown)")));
+           PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP));
            PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
        }
     }
     else {
-       PUSHs(sv_2mortal(newSVpvs("(eval)")));
+       PUSHs(newSVpvs_flags("(eval)", SVs_TEMP));
        PUSHs(sv_2mortal(newSViv(0)));
     }
     gimme = (I32)cx->blk_gimme;
index 36e5638..f7c37dd 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -388,7 +388,7 @@ PP(pp_glob)
     PL_last_in_gv = (GV*)*PL_stack_sp--;
 
     SAVESPTR(PL_rs);           /* This is not permanent, either. */
-    PL_rs = sv_2mortal(newSVpvs("\000"));
+    PL_rs = newSVpvs_flags("\000", SVs_TEMP);
 #ifndef DOSISH
 #ifndef CSH
     *SvPVX(PL_rs) = '\n';
@@ -437,7 +437,7 @@ PP(pp_warn)
        tmps = SvPV_const(tmpsv, len);
     }
     if (!tmps || !len)
-       tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
+       tmpsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
 
     Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv));
     RETSETYES;
@@ -501,7 +501,7 @@ PP(pp_die)
        }
     }
     if (!tmps || !len)
-       tmpsv = sv_2mortal(newSVpvs("Died"));
+       tmpsv = newSVpvs_flags("Died", SVs_TEMP);
 
     DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
 }
@@ -936,7 +936,7 @@ PP(pp_dbmopen)
     GV *gv;
 
     HV * const hv = (HV*)POPs;
-    SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
+    SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
     stash = gv_stashsv(sv, 0);
     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
        PUTBACK;
@@ -2898,7 +2898,7 @@ PP(pp_stat)
 #ifdef USE_STAT_RDEV
        PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
 #else
-       PUSHs(sv_2mortal(newSVpvs("")));
+       PUSHs(newSVpvs_flags("", SVs_TEMP));
 #endif
 #if Off_t_size > IVSIZE
        PUSHs(sv_2mortal(newSVnv((NV)PL_statcache.st_size)));
@@ -2918,8 +2918,8 @@ PP(pp_stat)
        PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
        PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blocks)));
 #else
-       PUSHs(sv_2mortal(newSVpvs("")));
-       PUSHs(sv_2mortal(newSVpvs("")));
+       PUSHs(newSVpvs_flags("", SVs_TEMP));
+       PUSHs(newSVpvs_flags("", SVs_TEMP));
 #endif
     }
     RETURN;
@@ -4607,7 +4607,7 @@ S_space_join_names_mortal(pTHX_ char *const *array)
     SV *target;
 
     if (array && *array) {
-       target = sv_2mortal(newSVpvs(""));
+       target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
            sv_catpv(target, *array);
            if (!*++array)
diff --git a/sv.c b/sv.c
index c50eef0..e348643 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1655,7 +1655,7 @@ S_not_a_number(pTHX_ SV *sv)
      const char *pv;
 
      if (DO_UTF8(sv)) {
-          dsv = sv_2mortal(newSVpvs(""));
+          dsv = newSVpvs_flags("", SVs_TEMP);
           pv = sv_uni_display(dsv, sv, 10, 0);
      } else {
          char *d = tmpbuf;
@@ -12212,7 +12212,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
-           return sv_2mortal(newSVpvs("${$/}"));
+           return newSVpvs_flags("${$/}", SVs_TEMP);
        /*FALLTHROUGH*/
 
     default:
diff --git a/toke.c b/toke.c
index 08e9acd..c3a8475 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -12504,7 +12504,7 @@ Perl_yyerror(pTHX_ const char *s)
            where = "within string";
     }
     else {
-       SV * const where_sv = sv_2mortal(newSVpvs("next char "));
+       SV * const where_sv = newSVpvs_flags("next char ", SVs_TEMP);
        if (yychar < 32)
            Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
        else if (isPRINT_LC(yychar)) {
index 8c3c247..50a76d6 100644 (file)
@@ -161,7 +161,7 @@ Perl_sv_does(pTHX_ SV *sv, const char *name)
     XPUSHs(sv_2mortal(newSVpv(name, 0)));
     PUTBACK;
 
-    methodname = sv_2mortal(newSVpvs("isa"));
+    methodname = newSVpvs_flags("isa", SVs_TEMP);
     /* ugly hack: use the SvSCREAM flag so S_method_common
      * can figure out we're calling DOES() and not isa(),
      * and report eventual errors correctly. --rgs */
@@ -986,7 +986,7 @@ XS(XS_PerlIO_get_layers)
                            const IV flags = SvIVX(*flgsvp);
 
                            if (flags & PERLIO_F_UTF8) {
-                                XPUSHs(sv_2mortal(newSVpvs("utf8")));
+                                XPUSHs(newSVpvs_flags("utf8", SVs_TEMP));
                                 nitem++;
                            }
                       }
diff --git a/utf8.c b/utf8.c
index efd894d..e22fe98 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -536,7 +536,7 @@ malformed:
     }
 
     if (dowarn) {
-       SV* const sv = sv_2mortal(newSVpvs("Malformed UTF-8 character "));
+       SV* const sv = newSVpvs_flags("Malformed UTF-8 character ", SVs_TEMP);
 
        switch (warning) {
        case 0: /* Intentionally empty. */ break;
diff --git a/util.c b/util.c
index f2039da..93f9646 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1025,7 +1025,7 @@ S_mess_alloc(pTHX)
     XPVMG *any;
 
     if (!PL_dirty)
-       return sv_2mortal(newSVpvs(""));
+       return newSVpvs_flags("", SVs_TEMP);
 
     if (PL_mess_sv)
        return PL_mess_sv;
index 1b871af..583527a 100644 (file)
--- a/xsutils.c
+++ b/xsutils.c
@@ -210,19 +210,19 @@ usage:
     case SVt_PVCV:
        cvflags = CvFLAGS((CV*)sv);
        if (cvflags & CVf_LOCKED)
-           XPUSHs(sv_2mortal(newSVpvs("locked")));
+           XPUSHs(newSVpvs_flags("locked", SVs_TEMP));
 #ifdef CVf_LVALUE
        if (cvflags & CVf_LVALUE)
-           XPUSHs(sv_2mortal(newSVpvs("lvalue")));
+           XPUSHs(newSVpvs_flags("lvalue", SVs_TEMP));
 #endif
        if (cvflags & CVf_METHOD)
-           XPUSHs(sv_2mortal(newSVpvs("method")));
+           XPUSHs(newSVpvs_flags("method", SVs_TEMP));
         if (GvUNIQUE(CvGV((CV*)sv)))
-           XPUSHs(sv_2mortal(newSVpvs("unique")));
+           XPUSHs(newSVpvs_flags("unique", SVs_TEMP));
        break;
     case SVt_PVGV:
        if (GvUNIQUE(sv))
-           XPUSHs(sv_2mortal(newSVpvs("unique")));
+           XPUSHs(newSVpvs_flags("unique", SVs_TEMP));
        break;
     default:
        break;