diff options
author | Chip Salzenberg <chip@pobox.com> | 2011-08-14 07:57:06 -0700 |
---|---|---|
committer | Chip Salzenberg <chip@pobox.com> | 2011-09-28 12:35:15 -0700 |
commit | 9e2dfd4eacd4fc62b9d83ad74afb0a68a9f0f562 (patch) | |
tree | 4a7c0b1a4e49188738b2c72623420beda7e839bc | |
parent | 450a7a1bbac26c29f4d17e66c5c3387e73388838 (diff) | |
download | perl-9e2dfd4eacd4fc62b9d83ad74afb0a68a9f0f562.tar.gz |
Fix SV flags for magic values, v2chip/magicflags2
-rw-r--r-- | av.c | 2 | ||||
-rw-r--r-- | cpan/Compress-Raw-Bzip2/Bzip2.xs | 68 | ||||
-rw-r--r-- | cpan/Compress-Raw-Zlib/Zlib.xs | 82 | ||||
-rw-r--r-- | doio.c | 4 | ||||
-rw-r--r-- | embed.fnc | 4 | ||||
-rw-r--r-- | embed.h | 2 | ||||
-rw-r--r-- | ext/Devel-Peek/t/Peek.t | 2 | ||||
-rw-r--r-- | mg.c | 187 | ||||
-rw-r--r-- | pp.c | 2 | ||||
-rw-r--r-- | pp_hot.c | 5 | ||||
-rw-r--r-- | pp_sys.c | 1 | ||||
-rw-r--r-- | proto.h | 14 | ||||
-rw-r--r-- | sv.c | 498 | ||||
-rw-r--r-- | sv.h | 175 | ||||
-rw-r--r-- | t/op/eval.t | 2 | ||||
-rw-r--r-- | t/op/tie.t | 5 |
16 files changed, 481 insertions, 572 deletions
@@ -950,7 +950,7 @@ Perl_av_exists(pTHX_ AV *av, I32 key) mg = mg_find(sv, PERL_MAGIC_tiedelem); if (mg) { magic_existspack(sv, mg); - return cBOOL(SvTRUE(sv)); + return cBOOL(SvTRUE_nomg(sv)); } } diff --git a/cpan/Compress-Raw-Bzip2/Bzip2.xs b/cpan/Compress-Raw-Bzip2/Bzip2.xs index 7c15ee68f4..128063c9b7 100644 --- a/cpan/Compress-Raw-Bzip2/Bzip2.xs +++ b/cpan/Compress-Raw-Bzip2/Bzip2.xs @@ -281,9 +281,8 @@ char * string; croak("%s: buffer parameter is a reference to a reference", string) ; } - if (!SvOK(sv)) { - sv = newSVpv("", 0); - } + if (!SvOK(sv)) + sv = sv_2mortal(newSVpv("", 0)); return sv ; } @@ -299,6 +298,7 @@ char * string ; { dTHX; bool wipe = 0 ; + STRLEN na; SvGETMAGIC(sv); wipe = ! SvOK(sv) ; @@ -323,14 +323,11 @@ char * string ; if (SvREADONLY(sv) && PL_curcop != &PL_compiling) croak("%s: buffer parameter is read-only", string); - SvUPGRADE(sv, SVt_PV); - + SvUPGRADE(sv, SVt_PV) ; if (wipe) - SvCUR_set(sv, 0); - - SvOOK_off(sv); - SvPOK_only(sv); - + sv_setpv(sv, "") ; + else + (void)SvPVbyte_force(sv, na) ; return sv ; } @@ -496,9 +493,9 @@ bzdeflate (s, buf, output) #ifdef UTF8_AVAILABLE if (DO_UTF8(buf) && !sv_utf8_downgrade(buf, 1)) croak("Wide character in " COMPRESS_CLASS "::bzdeflate input parameter"); -#endif - s->stream.next_in = (char*)SvPVbyte_nolen(buf) ; - s->stream.avail_in = SvCUR(buf) ; +#endif + s->stream.next_in = SvPV_nomg_nolen(buf); + s->stream.avail_in = SvCUR(buf); /* and retrieve the output buffer */ output = deRef_l(output, "deflate") ; @@ -506,13 +503,10 @@ bzdeflate (s, buf, output) if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) croak("Wide character in " COMPRESS_CLASS "::bzdeflate output parameter"); #endif - - if((s->flags & FLAG_APPEND_OUTPUT) != FLAG_APPEND_OUTPUT) { + if((s->flags & FLAG_APPEND_OUTPUT) != FLAG_APPEND_OUTPUT) SvCUR_set(output, 0); - /* sv_setpvn(output, "", 0); */ - } cur_length = SvCUR(output) ; - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length; + s->stream.next_out = SvPVX(output) + cur_length; increment = SvLEN(output) - cur_length; s->stream.avail_out = increment; while (s->stream.avail_in != 0) { @@ -521,7 +515,7 @@ bzdeflate (s, buf, output) /* out of space in the output buffer so make it bigger */ Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -571,12 +565,10 @@ bzclose(s, output) if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) croak("Wide character in " COMPRESS_CLASS "::bzclose input parameter"); #endif - if(! s->flags & FLAG_APPEND_OUTPUT) { + if(! s->flags & FLAG_APPEND_OUTPUT) SvCUR_set(output, 0); - /* sv_setpvn(output, "", 0); */ - } cur_length = SvCUR(output) ; - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length; + s->stream.next_out = SvPVX(output) + cur_length; increment = SvLEN(output) - cur_length; s->stream.avail_out = increment; @@ -585,7 +577,7 @@ bzclose(s, output) /* consumed all the available output, so extend it */ Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -632,12 +624,10 @@ bzflush(s, output) if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) croak("Wide character in " COMPRESS_CLASS "::bzflush input parameter"); #endif - if(! s->flags & FLAG_APPEND_OUTPUT) { + if(! s->flags & FLAG_APPEND_OUTPUT) SvCUR_set(output, 0); - /* sv_setpvn(output, "", 0); */ - } cur_length = SvCUR(output) ; - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length; + s->stream.next_out = SvPVX(output) + cur_length; increment = SvLEN(output) - cur_length; s->stream.avail_out = increment; @@ -646,7 +636,7 @@ bzflush(s, output) /* consumed all the available output, so extend it */ Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -743,8 +733,8 @@ bzinflate (s, buf, output) #endif /* initialise the input buffer */ - s->stream.next_in = (char*)SvPVbyte_force(buf, stmp) ; - s->stream.avail_in = SvCUR(buf); + s->stream.next_in = SvPV_nomg_nolen(buf); + s->stream.avail_in = stmp = SvCUR(buf); /* and retrieve the output buffer */ output = deRef_l(output, "bzinflate") ; @@ -774,7 +764,7 @@ bzinflate (s, buf, output) */ if (SvLEN(output) > cur_length + 1) { - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length; + s->stream.next_out = SvPVX(output) + cur_length; increment = SvLEN(output) - cur_length - 1; s->stream.avail_out = increment; } @@ -790,7 +780,7 @@ bzinflate (s, buf, output) /* out of space in the output buffer so make it bigger */ Sv_Grow(output, SvLEN(output) + bufinc + 1) ; cur_length += increment ; - s->stream.next_out = (char*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -823,21 +813,21 @@ bzinflate (s, buf, output) SvPOK_only(output); SvCUR_set(output, prefix_length + s->bytesInflated) ; - *SvEND(output) = '\0'; + *SvEND(output) = '\0' ; #ifdef UTF8_AVAILABLE if (out_utf8) - sv_utf8_upgrade(output); + sv_utf8_upgrade(output) ; #endif - SvSETMAGIC(output); + SvSETMAGIC(output) ; /* fix the input buffer */ if (s->flags & FLAG_CONSUME_INPUT) { in = s->stream.avail_in ; SvCUR_set(buf, in) ; if (in) - Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; - *SvEND(buf) = '\0'; - SvSETMAGIC(buf); + Move(s->stream.next_in, SvPVX(buf), in, char) ; + *SvEND(buf) = '\0' ; + SvSETMAGIC(buf) ; } } OUTPUT: diff --git a/cpan/Compress-Raw-Zlib/Zlib.xs b/cpan/Compress-Raw-Zlib/Zlib.xs index 70713b918e..4cadc7b04f 100644 --- a/cpan/Compress-Raw-Zlib/Zlib.xs +++ b/cpan/Compress-Raw-Zlib/Zlib.xs @@ -548,9 +548,8 @@ char * string; croak("%s: buffer parameter is a reference to a reference", string) ; } - if (!SvOK(sv)) { - sv = newSVpv("", 0); - } + if (!SvOK(sv)) + sv = sv_2mortal(newSVpv("", 0)); return sv ; } @@ -566,6 +565,7 @@ char * string ; { dTHX; bool wipe = 0 ; + STRLEN na; SvGETMAGIC(sv); wipe = ! SvOK(sv) ; @@ -590,14 +590,11 @@ char * string ; if (SvREADONLY(sv) && PL_curcop != &PL_compiling) croak("%s: buffer parameter is read-only", string); - SvUPGRADE(sv, SVt_PV); - + SvUPGRADE(sv, SVt_PV) ; if (wipe) - SvCUR_set(sv, 0); - - SvOOK_off(sv); - SvPOK_only(sv); - + sv_setpv(sv, "") ; + else + (void)SvPVbyte_force(sv, na) ; return sv ; } @@ -758,13 +755,13 @@ _deflateInit(flags,level, method, windowBits, memLevel, strategy, bufsize, dicti /* Check if a dictionary has been specified */ - if (err == Z_OK && SvCUR(dictionary)) { + SvGETMAGIC(dictionary); + if (err == Z_OK && SvPOK(dictionary) && SvCUR(dictionary)) { #ifdef UTF8_AVAILABLE - if (DO_UTF8(dictionary) && !sv_utf8_downgrade(dictionary, 1)) - croak("Wide character in Compress::Raw::Zlib::Deflate::new dicrionary parameter"); + if (DO_UTF8(dictionary) && !sv_utf8_downgrade(dictionary, 1)) + croak("Wide character in Compress::Raw::Zlib::Deflate::new dicrionary parameter"); #endif - err = deflateSetDictionary(&(s->stream), (const Bytef*) SvPVbyte_nolen(dictionary), - SvCUR(dictionary)) ; + err = deflateSetDictionary(&(s->stream), (const Bytef*) SvPVX(dictionary), SvCUR(dictionary)) ; s->dict_adler = s->stream.adler ; } @@ -887,11 +884,11 @@ deflate (s, buf, output) Compress::Raw::Zlib::deflateStream s SV * buf SV * output - uInt cur_length = NO_INIT - uInt increment = NO_INIT - uInt prefix = NO_INIT - int RETVAL = 0; - uLong bufinc = NO_INIT + PREINIT: + uInt cur_length; + uInt increment; + uInt prefix; + uLong bufinc; CODE: bufinc = s->bufsize; @@ -903,7 +900,7 @@ deflate (s, buf, output) if (DO_UTF8(buf) && !sv_utf8_downgrade(buf, 1)) croak("Wide character in Compress::Raw::Zlib::Deflate::deflate input parameter"); #endif - s->stream.next_in = (Bytef*)SvPVbyte_nolen(buf) ; + s->stream.next_in = (Bytef*)SvPV_nomg_nolen(buf) ; s->stream.avail_in = SvCUR(buf) ; if (s->flags & FLAG_CRC32) @@ -924,7 +921,7 @@ deflate (s, buf, output) /* sv_setpvn(output, "", 0); */ } prefix = cur_length = SvCUR(output) ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length; + s->stream.next_out = (Bytef*) SvPVX(output) + cur_length; increment = SvLEN(output) - cur_length; s->stream.avail_out = increment; #ifdef SETP_BYTE @@ -955,13 +952,14 @@ deflate (s, buf, output) s->deflateParams_out_length = 0; } #endif + RETVAL = Z_OK ; while (s->stream.avail_in != 0) { if (s->stream.avail_out == 0) { /* out of space in the output buffer so make it bigger */ Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = (Bytef*) SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -1024,7 +1022,7 @@ flush(s, output, f=Z_FINISH) /* sv_setpvn(output, "", 0); */ } prefix = cur_length = SvCUR(output) ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length; + s->stream.next_out = (Bytef*) SvPVX(output) + cur_length; increment = SvLEN(output) - cur_length; s->stream.avail_out = increment; #ifdef SETP_BYTE @@ -1061,7 +1059,7 @@ flush(s, output, f=Z_FINISH) /* consumed all the available output, so extend it */ Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = (Bytef*) SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -1274,12 +1272,11 @@ inflate (s, buf, output, eof=FALSE) SV * buf SV * output bool eof + PREINIT: uInt cur_length = 0; uInt prefix_length = 0; int increment = 0; - STRLEN stmp = NO_INIT - uLong bufinc = NO_INIT - PREINIT: + uLong bufinc; #ifdef UTF8_AVAILABLE bool out_utf8 = FALSE; #endif @@ -1296,7 +1293,7 @@ inflate (s, buf, output, eof=FALSE) #endif /* initialise the input buffer */ - s->stream.next_in = (Bytef*)SvPVbyte_force(buf, stmp) ; + s->stream.next_in = (Bytef*)SvPV_nomg_nolen(buf) ; s->stream.avail_in = SvCUR(buf) ; /* and retrieve the output buffer */ @@ -1328,7 +1325,7 @@ inflate (s, buf, output, eof=FALSE) */ if (SvLEN(output) > cur_length + 1) { - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length; + s->stream.next_out = (Bytef*) SvPVX(output) + cur_length; increment = SvLEN(output) - cur_length - 1; s->stream.avail_out = increment; } @@ -1344,7 +1341,7 @@ inflate (s, buf, output, eof=FALSE) /* out of space in the output buffer so make it bigger */ Sv_Grow(output, SvLEN(output) + bufinc +1) ; cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = (Bytef*) SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -1362,7 +1359,7 @@ Perl_sv_dump(output); */ if (RETVAL == Z_NEED_DICT && s->dictionary) { s->dict_adler = s->stream.adler ; RETVAL = inflateSetDictionary(&(s->stream), - (const Bytef*)SvPVbyte_nolen(s->dictionary), + (const Bytef*)SvPVX(s->dictionary), SvCUR(s->dictionary)); if (RETVAL == Z_OK) continue; @@ -1395,7 +1392,7 @@ Perl_sv_dump(output); */ /* out of space in the output buffer so make it bigger */ Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; - s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; + s->stream.next_out = (Bytef*) SvPVX(output) + cur_length ; increment = bufinc ; s->stream.avail_out = increment; bufinc *= 2 ; @@ -1425,12 +1422,12 @@ Perl_sv_dump(output); */ if (s->flags & FLAG_CRC32 ) s->crc32 = crc32(s->crc32, - (const Bytef*)SvPVbyte_nolen(output)+prefix_length, + (const Bytef*)SvPVX(output)+prefix_length, SvCUR(output)-prefix_length) ; if (s->flags & FLAG_ADLER32) s->adler32 = adler32(s->adler32, - (const Bytef*)SvPVbyte_nolen(output)+prefix_length, + (const Bytef*)SvPVX(output)+prefix_length, SvCUR(output)-prefix_length) ; /* fix the input buffer */ @@ -1438,7 +1435,7 @@ Perl_sv_dump(output); */ in = s->stream.avail_in ; SvCUR_set(buf, in) ; if (in) - Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; + Move(s->stream.next_in, SvPVX(buf), in, char) ; *SvEND(buf) = '\0'; SvSETMAGIC(buf); } @@ -1486,7 +1483,7 @@ inflateSync (s, buf) #endif /* initialise the input buffer */ - s->stream.next_in = (Bytef*)SvPVbyte_nolen(buf) ; + s->stream.next_in = (Bytef*)SvPV_nomg_nolen(buf) ; s->stream.avail_in = SvCUR(buf) ; /* inflateSync doesn't create any output */ @@ -1501,7 +1498,7 @@ inflateSync (s, buf) unsigned in = s->stream.avail_in ; SvCUR_set(buf, in) ; if (in) - Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; + Move(s->stream.next_in, SvPVX(buf), in, char) ; *SvEND(buf) = '\0'; SvSETMAGIC(buf); } @@ -1647,7 +1644,6 @@ scan(s, buf, out=NULL, eof=FALSE) bool eof bool eof_mode = FALSE; int start_len = NO_INIT - STRLEN stmp = NO_INIT CODE: /* If the input buffer is a reference, dereference it */ #ifndef MAGIC_APPEND @@ -1660,7 +1656,7 @@ scan(s, buf, out=NULL, eof=FALSE) croak("Wide character in Compress::Raw::Zlib::InflateScan::scan input parameter"); #endif /* initialise the input buffer */ - s->stream.next_in = (Bytef*)SvPVbyte_force(buf, stmp) ; + s->stream.next_in = (Bytef*)SvPV_nomg_nolen(buf) ; s->stream.avail_in = SvCUR(buf) ; start_len = s->stream.avail_in ; s->bytesInflated = 0 ; @@ -1745,9 +1741,9 @@ scan(s, buf, out=NULL, eof=FALSE) unsigned in = s->stream.avail_in ; SvCUR_set(buf, in) ; if (in) - Move(s->stream.next_in, SvPVbyte_nolen(buf), in, char) ; - *SvEND(buf) = '\0'; - SvSETMAGIC(buf); + Move(s->stream.next_in, SvPVX(buf), in, char) ; + *SvEND(buf) = '\0'; + SvSETMAGIC(buf); } } #endif @@ -740,6 +740,7 @@ Perl_nextargv(pTHX_ register GV *gv) STRLEN oldlen; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); + SvTAINTED_off(GvSVn(gv)); /* previous tainting irrelevant */ sv_setsv(GvSVn(gv),sv); SvSETMAGIC(GvSV(gv)); PL_oldname = SvPVx(GvSV(gv), oldlen); @@ -2273,9 +2274,10 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) if (optype == OP_SHMREAD) { char *mbuf; /* suppress warning when reading into undef var (tchrist 3/Mar/00) */ + SvGETMAGIC(mstr); + SvUPGRADE(mstr, SVt_PV); if (! SvOK(mstr)) sv_setpvs(mstr, ""); - SvUPGRADE(mstr, SVt_PV); SvPOK_only(mstr); mbuf = SvGROW(mstr, (STRLEN)msize+1); @@ -2080,7 +2080,9 @@ Apd |void |sv_catsv_flags |NN SV *const dsv|NULLOK SV *const ssv|const I32 flags Apmd |STRLEN |sv_utf8_upgrade_flags|NN SV *const sv|const I32 flags Ap |STRLEN |sv_utf8_upgrade_flags_grow|NN SV *const sv|const I32 flags|STRLEN extra Apd |char* |sv_pvn_force_flags|NN SV *const sv|NULLOK STRLEN *const lp|const I32 flags -Apd |void |sv_copypv |NN SV *const dsv|NN SV *const ssv +pmb |void |sv_copypv |NN SV *const dsv|NN SV *const ssv +Apmd |void |sv_copypv_nomg |NN SV *const dsv|NN SV *const ssv +Apd |void |sv_copypv_flags |NN SV *const dsv|NN SV *const ssv|const I32 flags Ap |char* |my_atof2 |NN const char *s|NN NV* value Apn |int |my_socketpair |int family|int type|int protocol|int fd[2] Ap |int |my_dirfd |NULLOK DIR* dir @@ -541,7 +541,7 @@ #define sv_cmp_flags(a,b,c) Perl_sv_cmp_flags(aTHX_ a,b,c) #define sv_cmp_locale_flags(a,b,c) Perl_sv_cmp_locale_flags(aTHX_ a,b,c) #define sv_compile_2op(a,b,c,d) Perl_sv_compile_2op(aTHX_ a,b,c,d) -#define sv_copypv(a,b) Perl_sv_copypv(aTHX_ a,b) +#define sv_copypv_flags(a,b,c) Perl_sv_copypv_flags(aTHX_ a,b,c) #define sv_dec(a) Perl_sv_dec(aTHX_ a) #define sv_dec_nomg(a) Perl_sv_dec_nomg(aTHX_ a) #define sv_derived_from(a,b) Perl_sv_derived_from(aTHX_ a,b) diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index f9074f0e96..3d9254f767 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -549,7 +549,7 @@ do_test('tainted value in %ENV', $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value 'SV = PVMG\\($ADDR\\) at $ADDR REFCNT = 1 - FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\) + FLAGS = \\(GMG,SMG,RMG,IOK,POK,pIOK,pPOK\\) IV = 0 NV = 0 PV = $ADDR "0"\\\0 @@ -76,6 +76,7 @@ void setegid(uid_t id); #endif /* + * Pre-magic setup and post-magic takedown. * Use the "DESTRUCTOR" scope cleanup to reinstate magic. */ @@ -97,6 +98,8 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) PERL_ARGS_ASSERT_SAVE_MAGIC; + assert(SvMAGICAL(sv)); + /* we shouldn't really be called here with RC==0, but it can sometimes * happen via mg_clear() (which also shouldn't be called when RC==0, * but it can happen). Handle this case gracefully(ish) by not RC++ @@ -108,11 +111,10 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) bumped = TRUE; } - assert(SvMAGICAL(sv)); /* Turning READONLY off for a copy-on-write scalar (including shared hash keys) is a bad idea. */ if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); + sv_force_normal_flags(sv, 0); SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix)); @@ -125,9 +127,66 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) SvMAGICAL_off(sv); SvREADONLY_off(sv); - if (!(SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK))) { - /* No public flags are set, so promote any private flags to public. */ - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; +} + +static void +S_restore_magic(pTHX_ const void *p) +{ + dVAR; + MGS* const mgs = SSPTR(PTR2IV(p), MGS*); + SV* const sv = mgs->mgs_sv; + bool bumped; + + if (!sv) + return; + + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { + SvTEMP_off(sv); /* if it's still magical, this value isn't temporary */ +#ifdef PERL_OLD_COPY_ON_WRITE + /* While magic was saved (and off) sv_setsv may well have seen + this SV as a prime candidate for COW. */ + if (SvIsCOW(sv)) + sv_force_normal_flags(sv, 0); +#endif + if (mgs->mgs_readonly) + SvREADONLY_on(sv); + if (mgs->mgs_magical) + SvFLAGS(sv) |= mgs->mgs_magical; + else + mg_magical(sv); + } + + bumped = mgs->mgs_bumped; + mgs->mgs_sv = NULL; /* mark the MGS structure as restored */ + + /* If we're still on top of the stack, pop us off. (That condition + * will be satisfied if restore_magic was called explicitly, but *not* + * if it's being called via leave_scope.) + * The reason for doing this is that otherwise, things like sv_2cv() + * may leave alloc gunk on the savestack, and some code + * (e.g. sighandler) doesn't expect that... + */ + if (PL_savestack_ix == mgs->mgs_ss_ix) + { + UV popval = SSPOPUV; + assert(popval == SAVEt_DESTRUCTOR_X); + PL_savestack_ix -= 2; + popval = SSPOPUV; + assert((popval & SAVE_MASK) == SAVEt_ALLOC); + PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT; + } + if (bumped) { + if (SvREFCNT(sv) == 1) { + /* We hold the last reference to this SV, which implies that the + SV was deleted as a side effect of the routines we called. + So artificially keep it alive a bit longer. + We avoid turning on the TEMP flag, which can cause the SV's + buffer to get stolen (and maybe other stuff). */ + sv_2mortal(sv); + SvTEMP_off(sv); + } + else + SvREFCNT_dec(sv); /* undo the inc in S_save_magic() */ } } @@ -948,21 +1007,17 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) else if (PL_compiling.cop_warnings == pWARN_ALL) { /* Get the bit mask for $warnings::Bits{all}, because * it could have been extended by warnings::register */ - HV * const bits=get_hv("warnings::Bits", 0); - if (bits) { - SV ** const bits_all = hv_fetchs(bits, "all", FALSE); - if (bits_all) - sv_setsv(sv, *bits_all); - } - else { - sv_setpvn(sv, WARN_ALLstring, WARNsize) ; - } + HV * const bits = get_hv("warnings::Bits", 0); + SV ** const bits_all = bits ? hv_fetchs(bits, "all", FALSE) : NULL; + if (bits_all) + sv_copypv(sv, *bits_all); + else + sv_setpvn(sv, WARN_ALLstring, WARNsize); } else { sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1), *PL_compiling.cop_warnings); } - SvPOK_only(sv); } break; case '\015': /* $^MATCH */ @@ -1074,6 +1129,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '\\': if (PL_ors_sv) sv_copypv(sv, PL_ors_sv); + else + sv_setsv(sv, &PL_sv_undef); break; case '$': /* $$ */ { @@ -1089,23 +1146,22 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { dSAVE_ERRNO; #ifdef VMS - sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno)); + sv_setiv(sv, (errno == EVMSERR) ? vaxc$errno : errno); #else - sv_setnv(sv, (NV)errno); + sv_setiv(sv, errno); #endif #ifdef OS2 if (errno == errno_isOS2 || errno == errno_isOS2_set) sv_setpv(sv, os2error(Perl_rc)); else #endif - sv_setpv(sv, errno ? Strerror(errno) : ""); + sv_setpv(sv, errno ? Strerror(errno) : ""); if (SvPOKp(sv)) - SvPOK_on(sv); /* may have got removed during taint processing */ + SvPOK_on(sv); /* may have got removed during taint processing - XXX OBSOLETE? CHIP */ RESTORE_ERRNO; } - SvRTRIM(sv); - SvNOK_on(sv); /* what a wonderful hack! */ + SvIOK_on(sv); /* what a wonderful hack! */ break; case '<': sv_setiv(sv, (IV)PL_uid); @@ -1324,7 +1380,6 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) else sv_setsv(sv,&PL_sv_undef); PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv); - SvTEMP_off(sv); } } return 0; @@ -2117,7 +2172,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) found->mg_len = -1; return 0; } - len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv); + len = SvPOK_nog(lsv) ? SvCUR(lsv) : sv_len(lsv); pos = SvIV(sv); @@ -2707,13 +2762,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_rs = newSVsv(sv); break; case '\\': - SvREFCNT_dec(PL_ors_sv); - if (SvOK(sv) || SvGMAGICAL(sv)) { - PL_ors_sv = newSVsv(sv); - } - else { + if (SvOK(sv)) + sv_copypv(PL_ors_sv = newSV(0), sv); + else PL_ors_sv = NULL; - } break; case '[': if (SvIV(sv) != 0) @@ -3140,83 +3192,6 @@ cleanup: return; } - -static void -S_restore_magic(pTHX_ const void *p) -{ - dVAR; - MGS* const mgs = SSPTR(PTR2IV(p), MGS*); - SV* const sv = mgs->mgs_sv; - bool bumped; - - if (!sv) - return; - - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) - { -#ifdef PERL_OLD_COPY_ON_WRITE - /* While magic was saved (and off) sv_setsv may well have seen - this SV as a prime candidate for COW. */ - if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); -#endif - - if (mgs->mgs_readonly) - SvREADONLY_on(sv); - if (mgs->mgs_magical) - SvFLAGS(sv) |= mgs->mgs_magical; - else - mg_magical(sv); - if (SvGMAGICAL(sv)) { - /* downgrade public flags to private, - and discard any other private flags */ - - const U32 pubflags = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - if (pubflags) { - SvFLAGS(sv) &= ~( pubflags | (SVp_IOK|SVp_NOK|SVp_POK) ); - SvFLAGS(sv) |= ( pubflags << PRIVSHIFT ); - } - } - } - - bumped = mgs->mgs_bumped; - mgs->mgs_sv = NULL; /* mark the MGS structure as restored */ - - /* If we're still on top of the stack, pop us off. (That condition - * will be satisfied if restore_magic was called explicitly, but *not* - * if it's being called via leave_scope.) - * The reason for doing this is that otherwise, things like sv_2cv() - * may leave alloc gunk on the savestack, and some code - * (e.g. sighandler) doesn't expect that... - */ - if (PL_savestack_ix == mgs->mgs_ss_ix) - { - UV popval = SSPOPUV; - assert(popval == SAVEt_DESTRUCTOR_X); - PL_savestack_ix -= 2; - popval = SSPOPUV; - assert((popval & SAVE_MASK) == SAVEt_ALLOC); - PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT; - } - if (bumped) { - if (SvREFCNT(sv) == 1) { - /* We hold the last reference to this SV, which implies that the - SV was deleted as a side effect of the routines we called. - So artificially keep it alive a bit longer. - We avoid turning on the TEMP flag, which can cause the SV's - buffer to get stolen (and maybe other stuff). */ - int was_temp = SvTEMP(sv); - sv_2mortal(sv); - if (!was_temp) { - SvTEMP_off(sv); - } - SvOK_off(sv); - } - else - SvREFCNT_dec(sv); /* undo the inc in S_save_magic() */ - } -} - /* clean up the mess created by Perl_sighandler(). * Note that this is only called during an exit in a signal handler; * a die is trapped by the call_sv() and the SAVEDESTRUCTOR_X manually @@ -1061,7 +1061,7 @@ PP(pp_postinc) if (SvROK(TOPs)) TARG = sv_newmortal(); sv_setsv(TARG, TOPs); - if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) + if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN)) { SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1)); @@ -366,7 +366,7 @@ PP(pp_preinc) PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC; if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs))) Perl_croak_no_modify(aTHX); - if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) + if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN)) { SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1)); @@ -739,7 +739,7 @@ PP(pp_print) if (PerlIO_write(fp, "\n", 1) == 0 || PerlIO_error(fp)) goto just_say_no; } - else if (PL_ors_sv && SvOK(PL_ors_sv)) + else if (PL_ors_sv && (SvGMAGICAL(PL_ors_sv) || SvOK(PL_ors_sv))) if (!do_print(PL_ors_sv, fp)) /* $\ */ goto just_say_no; @@ -1567,6 +1567,7 @@ Perl_do_readline(pTHX) if (av_len(GvAVn(PL_last_in_gv)) < 0) { IoFLAGS(io) &= ~IOf_START; do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL); + SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */ sv_setpvs(GvSVn(PL_last_in_gv), "-"); SvSETMAGIC(GvSV(PL_last_in_gv)); fp = IoIFP(io); @@ -2788,6 +2788,7 @@ PP(pp_stat) goto do_fstat_have_io; } + SvTAINTED_off(PL_statname); /* previous tainting irrelevant */ sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); PL_statgv = NULL; PL_laststype = PL_op->op_type; @@ -3726,12 +3726,22 @@ PERL_CALLCONV OP* Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, cons #define PERL_ARGS_ASSERT_SV_COMPILE_2OP_IS_BROKEN \ assert(sv); assert(startop); assert(code); assert(padp) -PERL_CALLCONV void Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv) +/* PERL_CALLCONV void Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv) __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2); + __attribute__nonnull__(pTHX_2); */ #define PERL_ARGS_ASSERT_SV_COPYPV \ assert(dsv); assert(ssv) +PERL_CALLCONV void Perl_sv_copypv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_SV_COPYPV_FLAGS \ + assert(dsv); assert(ssv) + +/* PERL_CALLCONV void Perl_sv_copypv_nomg(pTHX_ SV *const dsv, SV *const ssv) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); */ + PERL_CALLCONV void Perl_sv_dec(pTHX_ SV *const sv); PERL_CALLCONV void Perl_sv_dec_nomg(pTHX_ SV *const sv); PERL_CALLCONV void Perl_sv_del_backref(pTHX_ SV *const tsv, SV *const sv) @@ -2255,22 +2255,37 @@ IV Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags) { dVAR; + if (!sv) return 0; - if (SvGMAGICAL(sv) || SvVALID(sv)) { + + if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) + mg_get(sv); + + if (SvROK(sv)) { + if (SvAMAGIC(sv)) { + SV * tmpstr; + if (flags & SV_SKIP_OVERLOAD) + return 0; + tmpstr = AMG_CALLunary(sv, numer_amg); + if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { + return SvIV(tmpstr); + } + } + return PTR2IV(SvRV(sv)); + } + + if (SvVALID(sv)) { /* FBMs use the space for SvIVX and SvNVX for other purposes, and use the same flag bit as SVf_IVisUV, so must not let them cache IVs. In practice they are extremely unlikely to actually get anywhere accessible by user Perl code - the only way that I'm aware of is when a constant subroutine which is used as the second argument to index. */ - if (flags & SV_GMAGIC) - mg_get(sv); if (SvIOKp(sv)) return SvIVX(sv); - if (SvNOKp(sv)) { + if (SvNOKp(sv)) return I_V(SvNVX(sv)); - } if (SvPOKp(sv) && SvLEN(sv)) { UV value; const int numtype @@ -2293,25 +2308,12 @@ Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags) } return I_V(Atof(SvPVX_const(sv))); } - if (SvROK(sv)) { - goto return_rok; - } - assert(SvTYPE(sv) >= SVt_PVMG); - /* This falls through to the report_uninit inside S_sv_2iuv_common. */ - } else if (SvTHINKFIRST(sv)) { - if (SvROK(sv)) { - return_rok: - if (SvAMAGIC(sv)) { - SV * tmpstr; - if (flags & SV_SKIP_OVERLOAD) - return 0; - tmpstr = AMG_CALLunary(sv, numer_amg); - if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { - return SvIV(tmpstr); - } - } - return PTR2IV(SvRV(sv)); - } + if (ckWARN(WARN_UNINITIALIZED)) + report_uninit(sv); + return 0; + } + + if (SvTHINKFIRST(sv)) { if (SvIsCOW(sv)) { sv_force_normal_flags(sv, 0); } @@ -2321,10 +2323,12 @@ Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags) return 0; } } + if (!SvIOKp(sv)) { if (S_sv_2iuv_common(aTHX_ sv)) return 0; } + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n", PTR2UV(sv),SvIVX(sv))); return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv); @@ -2344,13 +2348,29 @@ UV Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags) { dVAR; + if (!sv) return 0; - if (SvGMAGICAL(sv) || SvVALID(sv)) { + + if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) + mg_get(sv); + + if (SvROK(sv)) { + if (SvAMAGIC(sv)) { + SV *tmpstr; + if (flags & SV_SKIP_OVERLOAD) + return 0; + tmpstr = AMG_CALLunary(sv, numer_amg); + if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { + return SvUV(tmpstr); + } + } + return PTR2UV(SvRV(sv)); + } + + if (SvVALID(sv)) { /* FBMs use the space for SvIVX and SvNVX for other purposes, and use the same flag bit as SVf_IVisUV, so must not let them cache IVs. */ - if (flags & SV_GMAGIC) - mg_get(sv); if (SvIOKp(sv)) return SvUVX(sv); if (SvNOKp(sv)) @@ -2372,25 +2392,12 @@ Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags) } return U_V(Atof(SvPVX_const(sv))); } - if (SvROK(sv)) { - goto return_rok; - } - assert(SvTYPE(sv) >= SVt_PVMG); - /* This falls through to the report_uninit inside S_sv_2iuv_common. */ - } else if (SvTHINKFIRST(sv)) { - if (SvROK(sv)) { - return_rok: - if (SvAMAGIC(sv)) { - SV *tmpstr; - if (flags & SV_SKIP_OVERLOAD) - return 0; - tmpstr = AMG_CALLunary(sv, numer_amg); - if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { - return SvUV(tmpstr); - } - } - return PTR2UV(SvRV(sv)); - } + if (ckWARN(WARN_UNINITIALIZED)) + report_uninit(sv); + return 0; + } + + if (SvTHINKFIRST(sv)) { if (SvIsCOW(sv)) { sv_force_normal_flags(sv, 0); } @@ -2400,6 +2407,7 @@ Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags) return 0; } } + if (!SvIOKp(sv)) { if (S_sv_2iuv_common(aTHX_ sv)) return 0; @@ -2722,191 +2730,147 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags *lp = 0; return (char *)""; } - if (SvGMAGICAL(sv)) { - if (flags & SV_GMAGIC) - mg_get(sv); - if (SvPOKp(sv)) { - if (lp) - *lp = SvCUR(sv); - if (flags & SV_MUTABLE_RETURN) - return SvPVX_mutable(sv); - if (flags & SV_CONST_RETURN) - return (char *)SvPVX_const(sv); - return SvPVX(sv); - } - if (SvIOKp(sv) || SvNOKp(sv)) { - char tbuf[64]; /* Must fit sprintf/Gconvert of longest IV/NV */ - STRLEN len; - if (SvIOKp(sv)) { - len = SvIsUV(sv) - ? my_snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv)) - : my_snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv)); - } else if(SvNVX(sv) == 0.0) { - tbuf[0] = '0'; - tbuf[1] = 0; - len = 1; - } else { - Gconvert(SvNVX(sv), NV_DIG, 0, tbuf); - len = strlen(tbuf); - } - assert(!SvROK(sv)); - { - dVAR; + if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) + mg_get(sv); - SvUPGRADE(sv, SVt_PV); - if (lp) - *lp = len; - s = SvGROW_mutable(sv, len + 1); - SvCUR_set(sv, len); - SvPOKp_on(sv); - return (char*)memcpy(s, tbuf, len + 1); - } - } - if (SvROK(sv)) { - goto return_rok; - } - assert(SvTYPE(sv) >= SVt_PVMG); - /* This falls through to the report_uninit near the end of the - function. */ - } else if (SvTHINKFIRST(sv)) { - if (SvROK(sv)) { - return_rok: - if (SvAMAGIC(sv)) { - SV *tmpstr; - if (flags & SV_SKIP_OVERLOAD) - return NULL; - tmpstr = AMG_CALLunary(sv, string_amg); - TAINT_IF(tmpstr && SvTAINTED(tmpstr)); - if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { - /* Unwrap this: */ - /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); - */ - - char *pv; - if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) { - if (flags & SV_CONST_RETURN) { - pv = (char *) SvPVX_const(tmpstr); - } else { - pv = (flags & SV_MUTABLE_RETURN) - ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr); - } - if (lp) - *lp = SvCUR(tmpstr); + if (SvROK(sv)) { + if (SvAMAGIC(sv)) { + SV *tmpstr; + if (flags & SV_SKIP_OVERLOAD) + return NULL; + tmpstr = AMG_CALLunary(sv, string_amg); + TAINT_IF(tmpstr && SvTAINTED(tmpstr)); + if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) { + /* Unwrap this: */ + /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); + */ + + char *pv; + if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) { + if (flags & SV_CONST_RETURN) { + pv = (char *) SvPVX_const(tmpstr); } else { - pv = sv_2pv_flags(tmpstr, lp, flags); + pv = (flags & SV_MUTABLE_RETURN) + ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr); } - if (SvUTF8(tmpstr)) - SvUTF8_on(sv); - else - SvUTF8_off(sv); - return pv; + if (lp) + *lp = SvCUR(tmpstr); + } else { + pv = sv_2pv_flags(tmpstr, lp, flags); } + if (SvUTF8(tmpstr)) + SvUTF8_on(sv); + else + SvUTF8_off(sv); + return pv; } - { - STRLEN len; - char *retval; - char *buffer; - SV *const referent = SvRV(sv); - - if (!referent) { - len = 7; - retval = buffer = savepvn("NULLREF", len); - } else if (SvTYPE(referent) == SVt_REGEXP) { - REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent); - I32 seen_evals = 0; - - assert(re); + } + { + STRLEN len; + char *retval; + char *buffer; + SV *const referent = SvRV(sv); + + if (!referent) { + len = 7; + retval = buffer = savepvn("NULLREF", len); + } else if (SvTYPE(referent) == SVt_REGEXP) { + REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent); + I32 seen_evals = 0; + + assert(re); - /* If the regex is UTF-8 we want the containing scalar to - have an UTF-8 flag too */ - if (RX_UTF8(re)) - SvUTF8_on(sv); - else - SvUTF8_off(sv); + /* If the regex is UTF-8 we want the containing scalar to + have an UTF-8 flag too */ + if (RX_UTF8(re)) + SvUTF8_on(sv); + else + SvUTF8_off(sv); - if ((seen_evals = RX_SEEN_EVALS(re))) - PL_reginterp_cnt += seen_evals; + if ((seen_evals = RX_SEEN_EVALS(re))) + PL_reginterp_cnt += seen_evals; - if (lp) - *lp = RX_WRAPLEN(re); + if (lp) + *lp = RX_WRAPLEN(re); - return RX_WRAPPED(re); - } else { - const char *const typestr = sv_reftype(referent, 0); - const STRLEN typelen = strlen(typestr); - UV addr = PTR2UV(referent); - const char *stashname = NULL; - STRLEN stashnamelen = 0; /* hush, gcc */ - const char *buffer_end; - - if (SvOBJECT(referent)) { - const HEK *const name = HvNAME_HEK(SvSTASH(referent)); - - if (name) { - stashname = HEK_KEY(name); - stashnamelen = HEK_LEN(name); - - if (HEK_UTF8(name)) { - SvUTF8_on(sv); - } else { - SvUTF8_off(sv); - } + return RX_WRAPPED(re); + } else { + const char *const typestr = sv_reftype(referent, 0); + const STRLEN typelen = strlen(typestr); + UV addr = PTR2UV(referent); + const char *stashname = NULL; + STRLEN stashnamelen = 0; /* hush, gcc */ + const char *buffer_end; + + if (SvOBJECT(referent)) { + const HEK *const name = HvNAME_HEK(SvSTASH(referent)); + + if (name) { + stashname = HEK_KEY(name); + stashnamelen = HEK_LEN(name); + + if (HEK_UTF8(name)) { + SvUTF8_on(sv); } else { - stashname = "__ANON__"; - stashnamelen = 8; + SvUTF8_off(sv); } - len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */ - + 2 * sizeof(UV) + 2 /* )\0 */; } else { - len = typelen + 3 /* (0x */ - + 2 * sizeof(UV) + 2 /* )\0 */; - } - - Newx(buffer, len, char); - buffer_end = retval = buffer + len; - - /* Working backwards */ - *--retval = '\0'; - *--retval = ')'; - do { - *--retval = PL_hexdigit[addr & 15]; - } while (addr >>= 4); - *--retval = 'x'; - *--retval = '0'; - *--retval = '('; - - retval -= typelen; - memcpy(retval, typestr, typelen); - - if (stashname) { - *--retval = '='; - retval -= stashnamelen; - memcpy(retval, stashname, stashnamelen); + stashname = "__ANON__"; + stashnamelen = 8; } - /* retval may not necessarily have reached the start of the - buffer here. */ - assert (retval >= buffer); + len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */ + + 2 * sizeof(UV) + 2 /* )\0 */; + } else { + len = typelen + 3 /* (0x */ + + 2 * sizeof(UV) + 2 /* )\0 */; + } - len = buffer_end - retval - 1; /* -1 for that \0 */ + Newx(buffer, len, char); + buffer_end = retval = buffer + len; + + /* Working backwards */ + *--retval = '\0'; + *--retval = ')'; + do { + *--retval = PL_hexdigit[addr & 15]; + } while (addr >>= 4); + *--retval = 'x'; + *--retval = '0'; + *--retval = '('; + + retval -= typelen; + memcpy(retval, typestr, typelen); + + if (stashname) { + *--retval = '='; + retval -= stashnamelen; + memcpy(retval, stashname, stashnamelen); } - if (lp) - *lp = len; - SAVEFREEPV(buffer); - return retval; + /* retval may not necessarily have reached the start of the + buffer here. */ + assert (retval >= buffer); + + len = buffer_end - retval - 1; /* -1 for that \0 */ } - } - if (SvREADONLY(sv) && !SvOK(sv)) { if (lp) - *lp = 0; - if (flags & SV_UNDEF_RETURNS_NULL) - return NULL; - if (ckWARN(WARN_UNINITIALIZED)) - report_uninit(sv); - return (char *)""; + *lp = len; + SAVEFREEPV(buffer); + return retval; } } - if (SvIOK(sv) || ((SvIOKp(sv) && !SvNOKp(sv)))) { + + if (SvPOKp(sv)) { + if (lp) + *lp = SvCUR(sv); + if (flags & SV_MUTABLE_RETURN) + return SvPVX_mutable(sv); + if (flags & SV_CONST_RETURN) + return (char *)SvPVX_const(sv); + return SvPVX(sv); + } + + if (SvIOK(sv)) { /* I'm assuming that if both IV and NV are equally valid then converting the IV is going to be more efficient */ const U32 isUIOK = SvIsUV(sv); @@ -2924,7 +2888,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags s += len; *s = '\0'; } - else if (SvNOKp(sv)) { + else if (SvNOK(sv)) { if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); if (SvNVX(sv) == 0.0) { @@ -2937,50 +2901,49 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags s = SvGROW_mutable(sv, NV_DIG + 20); /* some Xenix systems wipe out errno here */ Gconvert(SvNVX(sv), NV_DIG, 0, s); - RESTORE_ERRNO; while (*s) s++; + RESTORE_ERRNO; } #ifdef hcx if (s[-1] == '.') *--s = '\0'; #endif } - else { - if (isGV_with_GP(sv)) { - GV *const gv = MUTABLE_GV(sv); - const U32 wasfake = SvFLAGS(gv) & SVf_FAKE; - SV *const buffer = sv_newmortal(); - - /* FAKE globs can get coerced, so need to turn this off temporarily - if it is on. */ - SvFAKE_off(gv); - gv_efullname3(buffer, gv, "*"); - SvFLAGS(gv) |= wasfake; - - if (SvPOK(buffer)) { - if (lp) { - *lp = SvCUR(buffer); - } - return SvPVX(buffer); - } - else { - if (lp) - *lp = 0; - return (char *)""; - } - } + else if (isGV_with_GP(sv)) { + GV *const gv = MUTABLE_GV(sv); + const U32 wasfake = SvFLAGS(gv) & SVf_FAKE; + SV *const buffer = sv_newmortal(); + + /* FAKE globs can get coerced, so need to turn this off temporarily + if it is on. */ + SvFAKE_off(gv); + gv_efullname3(buffer, gv, "*"); + SvFLAGS(gv) |= wasfake; + if (SvPOK(buffer)) { + if (lp) + *lp = SvCUR(buffer); + return SvPVX(buffer); + } + else { + if (lp) + *lp = 0; + return (char *)""; + } + } + else { if (lp) *lp = 0; if (flags & SV_UNDEF_RETURNS_NULL) return NULL; if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); - if (SvTYPE(sv) < SVt_PV) - /* Typically the caller expects that sv_any is not NULL now. */ + /* Typically the caller expects that sv_any is not NULL now. */ + if (!SvREADONLY(sv) && SvTYPE(sv) < SVt_PV) sv_upgrade(sv, SVt_PV); return (char *)""; } + { const STRLEN len = s - SvPVX_const(sv); if (lp) @@ -3008,17 +2971,32 @@ sv_2pv[_flags] but operates directly on an SV instead of just the string. Mostly uses sv_2pv_flags to do its work, except when that would lose the UTF-8'ness of the PV. +=for apidoc sv_copypv_nomg + +Like sv_copypv, but doesn't invoke get magic first. + =cut */ void Perl_sv_copypv(pTHX_ SV *const dsv, register SV *const ssv) { + PERL_ARGS_ASSERT_SV_COPYPV; + + sv_copypv_flags(dsv, ssv, 0); +} + +void +Perl_sv_copypv_flags(pTHX_ SV *const dsv, register SV *const ssv, const I32 flags) +{ STRLEN len; - const char * const s = SvPV_const(ssv,len); + const char *s; - PERL_ARGS_ASSERT_SV_COPYPV; + PERL_ARGS_ASSERT_SV_COPYPV_FLAGS; + if ((flags & SV_GMAGIC) && SvGMAGICAL(ssv)) + mg_get(ssv); + s = SvPV_nomg_const(ssv,len); sv_setpvn(dsv,s,len); if (SvUTF8(ssv)) SvUTF8_on(dsv); @@ -3093,7 +3071,8 @@ Perl_sv_2bool_flags(pTHX_ register SV *const sv, const I32 flags) PERL_ARGS_ASSERT_SV_2BOOL_FLAGS; - if(flags & SV_GMAGIC) SvGETMAGIC(sv); + if (flags & SV_GMAGIC) + SvGETMAGIC(sv); if (!SvOK(sv)) return 0; @@ -3105,30 +3084,7 @@ Perl_sv_2bool_flags(pTHX_ register SV *const sv, const I32 flags) } return SvRV(sv) != 0; } - if (SvPOKp(sv)) { - register XPV* const Xpvtmp = (XPV*)SvANY(sv); - if (Xpvtmp && - (*sv->sv_u.svu_pv > '0' || - Xpvtmp->xpv_cur > 1 || - (Xpvtmp->xpv_cur && *sv->sv_u.svu_pv != '0'))) - return 1; - else - return 0; - } - else { - if (SvIOKp(sv)) - return SvIVX(sv) != 0; - else { - if (SvNOKp(sv)) - return SvNVX(sv) != 0.0; - else { - if (isGV_with_GP(sv)) - return TRUE; - else - return FALSE; - } - } - } + return SvTRUE_common(sv, isGV_with_GP(sv) ? 1 : 0); } /* @@ -5202,8 +5158,6 @@ Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how, mg->mg_virtual = (MGVTBL *) vtable; mg_magical(sv); - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); return mg; } @@ -5270,13 +5224,8 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how, /* sv_magic() refuses to add a magic of the same 'how' as an existing one */ - if (how == PERL_MAGIC_taint) { + if (how == PERL_MAGIC_taint) mg->mg_len |= 1; - /* Any scalar which already had taint magic on which someone - (erroneously?) did SvIOK_on() or similar will now be - incorrectly sporting public "OK" flags. */ - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - } return; } } @@ -5691,6 +5640,7 @@ Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN l if (!bigstr) Perl_croak(aTHX_ "Can't modify non-existent substring"); + SvGETMAGIC(bigstr); SvPV_force_flags(bigstr, curlen, flags); (void)SvPOK_only_UTF8(bigstr); if (offset + len > curlen) { @@ -881,6 +881,25 @@ in gv.h: */ (SvROK(sv) && (SvFLAGS(SvRV(sv)) &= ~SVf_AMAGIC)) #endif + +#define SvPOK_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK) +#define SvIOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVs_GMG)) == SVf_IOK) +#define SvUOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) +#define SvNOK_nog(sv) ((SvFLAGS(sv) & (SVf_NOK|SVs_GMG)) == SVf_NOK) +#define SvNIOK_nog(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & SVs_GMG)) + +#define SvPOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) +#define SvIOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_THINKFIRST|SVs_GMG)) == SVf_IOK) +#define SvUOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVf_THINKFIRST|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) +#define SvNOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_NOK|SVf_THINKFIRST|SVs_GMG)) == SVf_NOK) +#define SvNIOK_nogthink(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & (SVf_THINKFIRST|SVs_GMG))) + +#define SvPOK_utf8_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == (SVf_POK|SVf_UTF8)) +#define SvPOK_utf8_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) + +#define SvPOK_byte_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == SVf_POK) +#define SvPOK_byte_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) + /* =for apidoc Am|U32|SvGAMAGIC|SV* sv @@ -1522,9 +1541,9 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv> */ /* Let us hope that bitmaps for UV and IV are the same */ -#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) -#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) -#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv)) +#define SvIV(sv) (SvIOK_nog(sv) ? SvIVX(sv) : sv_2iv(sv)) +#define SvUV(sv) (SvUOK_nog(sv) ? SvUVX(sv) : sv_2uv(sv)) +#define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv)) #define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0)) #define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0)) @@ -1532,23 +1551,23 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv> /* ----*/ -#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC) -#define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) +#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC) +#define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) #define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) #define SvPV_flags(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) #define SvPV_flags_const(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) #define SvPV_flags_const_nolen(sv, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX_const(sv) : \ (const char*) sv_2pv_flags(sv, 0, flags|SV_CONST_RETURN)) #define SvPV_flags_mutable(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) @@ -1560,26 +1579,28 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv> #define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) #define SvPV_force_flags(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) + (SvPOK_nogthink(sv) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) + #define SvPV_force_flags_nolen(sv, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags)) + (SvPOK_nogthink(sv) \ + ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags)) + #define SvPV_force_flags_mutable(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ + (SvPOK_nogthink(sv) \ + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) #define SvPV_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC)) #define SvPV_nomg_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX(sv) : sv_2pv_flags(sv, 0, 0)) #define SvPV_nolen_const(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + (SvPOK_nog(sv) \ ? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN)) #define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) @@ -1589,32 +1610,30 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv> /* ----*/ #define SvPVutf8(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \ + (SvPOK_utf8_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp)) -#define SvPVutf8_force(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) - - #define SvPVutf8_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\ + (SvPOK_utf8_nog(sv) \ ? SvPVX(sv) : sv_2pvutf8(sv, 0)) +#define SvPVutf8_force(sv, lp) \ + (SvPOK_utf8_nogthink(sv) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) + /* ----*/ #define SvPVbyte(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ + (SvPOK_byte_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) -#define SvPVbyte_force(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp)) - #define SvPVbyte_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)\ + (SvPOK_byte_nog(sv) \ ? SvPVX(sv) : sv_2pvbyte(sv, 0)) +#define SvPVbyte_force(sv, lp) \ + (SvPOK_byte_nogthink(sv) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp)) /* define FOOx(): idempotent versions of FOO(). If possible, use a local @@ -1626,6 +1645,17 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv> #define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp) #define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp) +#define SvTRUE(sv) ((sv) && (SvGMAGICAL(sv) ? sv_2bool(sv) : SvTRUE_common(sv, sv_2bool_nomg(sv)))) +#define SvTRUE_nomg(sv) ((sv) && ( SvTRUE_common(sv, sv_2bool_nomg(sv)))) +#define SvTRUE_common(sv,fallback) ( \ + !SvOK(sv) \ + ? 0 \ + : (SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK)) \ + ? ( (SvPOK(sv) && SvPVXtrue(sv)) \ + || (SvIOK(sv) && SvIVX(sv) != 0) \ + || (SvNOK(sv) && SvNVX(sv) != 0.0)) \ + : (fallback)) + #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define SvIVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvIV(_sv); }) @@ -1638,39 +1668,13 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv> # define SvPVutf8x(sv, lp) ({SV *_sv = (sv); SvPVutf8(_sv, lp); }) # define SvPVbytex(sv, lp) ({SV *_sv = (sv); SvPVbyte(_sv, lp); }) # define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); }) -# define SvTRUE(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? (({XPV *nxpv = (XPV*)SvANY(sv); \ - nxpv && \ - (nxpv->xpv_cur > 1 || \ - (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool(sv) ) -# define SvTRUE_nomg(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? (({XPV *nxpv = (XPV*)SvANY(sv); \ - nxpv && \ - (nxpv->xpv_cur > 1 || \ - (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool_flags(sv,0) ) -# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); }) +# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); }) +# define SvTRUEx_nomg(sv) ({SV *_sv = (sv); SvTRUE_nomg(_sv); }) +# define SvPVXtrue(sv) \ + ({XPV *nxpv; \ + (nxpv = (XPV*)SvANY(sv)) \ + && (nxpv->xpv_cur > 1 \ + || (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0'));}) #else /* __GNUC__ */ @@ -1687,37 +1691,12 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv> # define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp)) # define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp)) # define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv)) -# define SvTRUE(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) && \ - (PL_Xpv->xpv_cur > 1 || \ - (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool(sv) ) -# define SvTRUE_nomg(sv) ( \ - !sv \ - ? 0 \ - : SvPOK(sv) \ - ? ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) && \ - (PL_Xpv->xpv_cur > 1 || \ - (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')) \ - ? 1 \ - : 0) \ - : \ - SvIOK(sv) \ - ? SvIVX(sv) != 0 \ - : SvNOK(sv) \ - ? SvNVX(sv) != 0.0 \ - : sv_2bool_flags(sv,0) ) -# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) +# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) +# define SvTRUEx_nomg(sv) ((PL_Sv = (sv)), SvTRUE_nomg(PL_Sv)) +# define SvPVXtrue(sv) \ + ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) \ + && (PL_Xpv->xpv_cur > 1 \ + || (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0'))) #endif /* __GNU__ */ #define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \ @@ -1820,8 +1799,9 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect #define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0) #define sv_catsv_mg(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC|SV_SMAGIC) #define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC) -#define sv_catpvn_mg(sv, sstr, slen) \ - sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC); +#define sv_catpvn_mg(sv, sstr, slen) sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC); +#define sv_copypv(dsv, ssv) sv_copypv_flags(dsv, ssv, SV_GMAGIC) +#define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0) #define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC) #define sv_2pv_nolen(sv) sv_2pv(sv, 0) #define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0) @@ -1837,6 +1817,7 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect #define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC) #define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC) #define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC) +#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0) #define sv_insert(bigstr, offset, len, little, littlelen) \ Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \ (littlelen), SV_GMAGIC) diff --git a/t/op/eval.t b/t/op/eval.t index 49a1ccab41..328dcadd3b 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -491,7 +491,7 @@ END_EVAL_TEST is($tombstone, "Done\n", 'Program completed successfully'); - $first =~ s/,pNOK//; + $first =~ s/p?[NI]OK,//g; s/ PV = 0x[0-9a-f]+/ PV = 0x/ foreach $first, $second; s/ LEN = [0-9]+/ LEN = / foreach $first, $second; # Dump may double newlines through pipes, though not files diff --git a/t/op/tie.t b/t/op/tie.t index 3d4eb20394..02b6b11d4c 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -273,12 +273,13 @@ EXPECT 0 ######## # -# FETCH freeing tie'd SV +# FETCH freeing tie'd SV still works sub TIESCALAR { bless [] } -sub FETCH { *a = \1; 1 } +sub FETCH { *a = \1; 2 } tie $a, 'main'; print $a; EXPECT +2 ######## # [20020716.007] - nested FETCHES |