From: Nicholas Clark Date: Thu, 3 Jan 2008 17:42:27 +0000 (+0000) Subject: Add newSVpvs_flags() as a wrapper to newSVpvn_flags(), and rework X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=84bafc024a74c819ac3d2b4406253dbe983e6502;p=p5sagit%2Fp5-mst-13.2.git Add newSVpvs_flags() as a wrapper to newSVpvn_flags(), and rework sv_2mortal(newSVpvs(...)) constructions to use it. p4raw-id: //depot/perl@32819 --- diff --git a/cop.h b/cop.h index 71397c3..39dc9cb 100644 --- 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 --- a/handy.h +++ b/handy.h @@ -244,6 +244,10 @@ typedef U64TYPE U64; =for apidoc Ama|SV*|newSVpvs|const char* s Like C, but takes a literal string instead of a string/length pair. +=for apidoc Ama|SV*|newSVpvs_flags|const char* s|U32 flags +Like C, but takes a literal string instead of a string/length +pair. + =for apidoc Ama|SV*|newSVpvs_share|const char* s Like C, 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 --- 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 --- 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) { diff --git a/pp_ctl.c b/pp_ctl.c index 8681cd9..e1ad0e9 100644 --- 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; diff --git a/pp_sys.c b/pp_sys.c index 36e5638..f7c37dd 100644 --- 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 --- 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 --- 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)) { diff --git a/universal.c b/universal.c index 8c3c247..50a76d6 100644 --- a/universal.c +++ b/universal.c @@ -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 --- 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 --- 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; diff --git a/xsutils.c b/xsutils.c index 1b871af..583527a 100644 --- 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;