mg = mg_find(sv, PERL_MAGIC_tiedelem);
if (mg) {
magic_existspack(sv, mg);
- return cBOOL(SvTRUE(sv));
+ return cBOOL(SvTRUE_nomg(sv));
}
}
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 ;
}
{
dTHX;
bool wipe = 0 ;
+ STRLEN na;
SvGETMAGIC(sv);
wipe = ! SvOK(sv) ;
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 ;
}
#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") ;
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) {
/* 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 ;
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;
/* 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 ;
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;
/* 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 ;
#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") ;
*/
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;
}
/* 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 ;
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:
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 ;
}
{
dTHX;
bool wipe = 0 ;
+ STRLEN na;
SvGETMAGIC(sv);
wipe = ! SvOK(sv) ;
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 ;
}
/* 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 ;
}
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;
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)
/* 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
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 ;
/* 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
/* 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 ;
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
#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 */
*/
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;
}
/* 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 ;
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;
/* 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 ;
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 */
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);
}
#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 */
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);
}
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
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 ;
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
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);
else if (lulen)
dcsave = savepvn(lc, lulen);
if (sv == left || sv == right)
- (void)sv_usepvn(sv, dcorig, needlen); /* Uses Renew(). */
+ (void)sv_usepvn(sv, dcorig, needlen); /* uses Renew(); defaults to nomg */
SvCUR_set(sv, dc - dcorig);
if (rulen)
- sv_catpvn(sv, dcsave, rulen);
+ sv_catpvn_nomg(sv, dcsave, rulen);
else if (lulen)
- sv_catpvn(sv, dcsave, lulen);
+ sv_catpvn_nomg(sv, dcsave, lulen);
else
*SvEND(sv) = '\0';
Safefree(dcsave);
mop_up:
len = lensave;
if (rightlen > len)
- sv_catpvn(sv, rsave + len, rightlen - len);
+ sv_catpvn_nomg(sv, rsave + len, rightlen - len);
else if (leftlen > (STRLEN)len)
- sv_catpvn(sv, lsave + len, leftlen - len);
+ sv_catpvn_nomg(sv, lsave + len, leftlen - len);
else
*SvEND(sv) = '\0';
break;
Apd |void |sv_vcatpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \
|NULLOK va_list *const args|NULLOK SV **const svargs|const I32 svmax \
|NULLOK bool *const maybe_tainted
+Apd |void |sv_vcatpvfn_flags|NN SV *const sv|NN const char *const pat|const STRLEN patlen \
+ |NULLOK va_list *const args|NULLOK SV **const svargs|const I32 svmax \
+ |NULLOK bool *const maybe_tainted|const U32 flags
Apd |void |sv_vsetpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \
|NULLOK va_list *const args|NULLOK SV **const svargs \
|const I32 svmax|NULLOK bool *const maybe_tainted
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
#define sv_clear(a) Perl_sv_clear(aTHX_ a)
#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_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)
#define sv_vcatpvf(a,b,c) Perl_sv_vcatpvf(aTHX_ a,b,c)
#define sv_vcatpvf_mg(a,b,c) Perl_sv_vcatpvf_mg(aTHX_ a,b,c)
#define sv_vcatpvfn(a,b,c,d,e,f,g) Perl_sv_vcatpvfn(aTHX_ a,b,c,d,e,f,g)
+#define sv_vcatpvfn_flags(a,b,c,d,e,f,g,h) Perl_sv_vcatpvfn_flags(aTHX_ a,b,c,d,e,f,g,h)
#define sv_vsetpvf(a,b,c) Perl_sv_vsetpvf(aTHX_ a,b,c)
#define sv_vsetpvf_mg(a,b,c) Perl_sv_vsetpvf_mg(aTHX_ a,b,c)
#define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
$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
}
LEAVE;
varsv = GvSVn(vargv);
+ SvTAINTED_off(varsv); /* previous $AUTOLOAD taint is obsolete */
+ /* XXX: this process is not careful to avoid extra magic gets and sets; tied $AUTOLOAD will get noise */
sv_setsv(varsv, packname);
sv_catpvs(varsv, "::");
/* Ensure SvSETMAGIC() is called if necessary. In particular, to clear
#endif
/*
+ * Pre-magic setup and post-magic takedown.
* Use the "DESTRUCTOR" scope cleanup to reinstate magic.
*/
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++
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))
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;
- }
}
/*
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 */
case '\\':
if (PL_ors_sv)
sv_copypv(sv, PL_ors_sv);
+ else
+ sv_setsv(sv, &PL_sv_undef);
break;
case '$': /* $$ */
{
else
#endif
sv_setpv(sv, errno ? Strerror(errno) : "");
- if (SvPOKp(sv))
- SvPOK_on(sv); /* may have got removed during taint processing */
RESTORE_ERRNO;
}
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);
if (!sv)
return;
- if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
- {
+ 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);
- 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;
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);
+ SvTEMP_off(sv);
}
else
SvREFCNT_dec(sv); /* undo the inc in S_save_magic() */
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));
assert(cx->sb_strend >= s);
if(cx->sb_strend > s) {
if (DO_UTF8(dstr) && !SvUTF8(targ))
- sv_catpvn_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv);
+ sv_catpvn_nomg_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv);
else
- sv_catpvn(dstr, s, cx->sb_strend - s);
+ sv_catpvn_nomg(dstr, s, cx->sb_strend - s);
}
if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
cx->sb_rxtainted |= SUBST_TAINT_PAT;
cx->sb_m = m = RX_OFFS(rx)[0].start + orig;
if (m > s) {
if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ))
- sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
+ sv_catpvn_nomg_utf8_upgrade(dstr, s, m - s, nsv);
else
- sv_catpvn(dstr, s, m-s);
+ sv_catpvn_nomg(dstr, s, m-s);
}
cx->sb_s = RX_OFFS(rx)[0].end + orig;
{ /* Update the pos() information. */
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));
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);
}
m = RX_OFFS(rx)[0].start + orig;
if (doutf8 && !SvUTF8(dstr))
- sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
+ sv_catpvn_nomg_utf8_upgrade(dstr, s, m - s, nsv);
else
- sv_catpvn(dstr, s, m-s);
+ sv_catpvn_nomg(dstr, s, m-s);
s = RX_OFFS(rx)[0].end + orig;
if (clen)
- sv_catpvn(dstr, c, clen);
+ sv_catpvn_nomg(dstr, c, clen);
if (once)
break;
} while (CALLREGEXEC(rx, s, strend, orig, s == m,
TARG, NULL, r_flags));
if (doutf8 && !DO_UTF8(TARG))
- sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
+ sv_catpvn_nomg_utf8_upgrade(dstr, s, strend - s, nsv);
else
- sv_catpvn(dstr, s, strend - s);
+ sv_catpvn_nomg(dstr, s, strend - s);
if (rpm->op_pmflags & PMf_NONDESTRUCT) {
/* From here on down we're using the copy, and leaving the original
if (! SvOK(bufsv))
sv_setpvs(bufsv, "");
length = SvIVx(*++MARK);
+ if (length < 0)
+ DIE(aTHX_ "Negative length");
SETERRNO(0,0);
if (MARK < SP)
offset = SvIVx(*++MARK);
buffer = SvPV_force(bufsv, blen);
buffer_utf8 = !IN_BYTES && SvUTF8(bufsv);
}
- if (length < 0)
- DIE(aTHX_ "Negative length");
- wanted = length;
+ if (DO_UTF8(bufsv)) {
+ /* offset adjust in characters not bytes */
+ /* SV's length cache is only safe for non-magical values */
+ if (SvGMAGICAL(bufsv))
+ blen = utf8_length((const U8 *)buffer, (const U8 *)buffer + blen);
+ else
+ blen = sv_len_utf8(bufsv);
+ }
charstart = TRUE;
charskip = 0;
skip = 0;
+ wanted = length;
#ifdef HAS_SOCKET
if (PL_op->op_type == OP_RECV) {
RETURN;
}
#endif
- if (DO_UTF8(bufsv)) {
- /* offset adjust in characters not bytes */
- blen = sv_len_utf8(bufsv);
- }
if (offset < 0) {
if (-offset > (SSize_t)blen)
DIE(aTHX_ "Offset outside string");
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;
PERL_CALLCONV I32 Perl_sv_cmp_flags(pTHX_ SV *const sv1, SV *const sv2, const U32 flags);
PERL_CALLCONV I32 Perl_sv_cmp_locale(pTHX_ SV *const sv1, SV *const sv2);
PERL_CALLCONV I32 Perl_sv_cmp_locale_flags(pTHX_ SV *const sv1, SV *const sv2, const U32 flags);
-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)
#define PERL_ARGS_ASSERT_SV_VCATPVFN \
assert(sv); assert(pat)
+PERL_CALLCONV void Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted, const U32 flags)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS \
+ assert(sv); assert(pat)
+
PERL_CALLCONV void Perl_sv_vsetpvf(pTHX_ SV *const sv, const char *const pat, va_list *const args)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
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
}
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);
}
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);
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))
}
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);
}
return 0;
}
}
+
if (!SvIOKp(sv)) {
if (S_sv_2iuv_common(aTHX_ sv))
return 0;
*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);
+ 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);
+ */
- 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);
+ 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 && (
- !(PL_curcop->cop_hints & HINT_NO_AMAGIC)
- || amagic_is_enabled(string_amg)
- )) {
- REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent);
-
- 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 &&
+ (!(PL_curcop->cop_hints & HINT_NO_AMAGIC) ||
+ amagic_is_enabled(string_amg))) {
+ REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent);
+
+ 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 (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);
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) {
*--s = '\0';
#endif
}
- else {
- if (isGV_with_GP(sv)) {
- GV *const gv = MUTABLE_GV(sv);
- SV *const buffer = sv_newmortal();
-
- gv_efullname3(buffer, gv, "*");
+ else if (isGV_with_GP(sv)) {
+ GV *const gv = MUTABLE_GV(sv);
+ SV *const buffer = sv_newmortal();
- assert(SvPOK(buffer));
- if (lp) {
- *lp = SvCUR(buffer);
- }
- if ( SvUTF8(buffer) ) SvUTF8_on(sv);
- return SvPVX(buffer);
- }
+ gv_efullname3(buffer, gv, "*");
+ assert(SvPOK(buffer));
+ if (SvUTF8(buffer))
+ SvUTF8_on(sv);
+ if (lp)
+ *lp = SvCUR(buffer);
+ return SvPVX(buffer);
+ }
+ else {
if (lp)
*lp = 0;
if (flags & SV_UNDEF_RETURNS_NULL)
return NULL;
if (!PL_localizing && !SvPADTMP(sv) && 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)
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.
+
+=for apidoc sv_copypv_flags
+
+Implementation of sv_copypv and sv_copypv_nomg. Calls get magic iff flags
+include SV_GMAGIC.
+
=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);
if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv))
sv = sv_mortalcopy(sv);
- sv_utf8_upgrade(sv);
- if (SvGMAGICAL(sv)) SvFLAGS(sv) &= ~SVf_POK;
- assert(SvPOKp(sv));
+ else
+ SvGETMAGIC(sv);
+ sv_utf8_upgrade_nomg(sv);
return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
}
}
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);
}
/*
/*
=for apidoc sv_catsv
-Concatenates the string from SV C<ssv> onto the end of the string in
-SV C<dsv>. Modifies C<dsv> but not C<ssv>. Handles 'get' magic, but
-not 'set' magic. See C<sv_catsv_mg>.
+Concatenates the string from SV C<ssv> onto the end of the string in SV
+C<dsv>. If C<ssv> is null, does nothing; otherwise modifies only C<dsv>.
+Handles 'get' magic on both SVs, but no 'set' magic. See C<sv_catsv_mg> and
+C<sv_catsv_nomg>.
=for apidoc sv_catsv_flags
-Concatenates the string from SV C<ssv> onto the end of the string in
-SV C<dsv>. Modifies C<dsv> but not C<ssv>. If C<flags> has C<SV_GMAGIC>
-bit set, will C<mg_get> on the C<ssv>, if appropriate, before
-reading it. If the C<flags> contain C<SV_SMAGIC>, C<mg_set> will be
-called on the modified SV afterward, if appropriate. C<sv_catsv>
-and C<sv_catsv_nomg> are implemented in terms of this function.
+Concatenates the string from SV C<ssv> onto the end of the string in SV
+C<dsv>. If C<ssv> is null, does nothing; otherwise modifies only C<dsv>.
+If C<flags> include C<SV_GMAGIC> bit set, will call C<mg_get> on both SVs if
+appropriate. If C<flags> include C<SV_SMAGIC>, C<mg_set> will be called on
+the modified SV afterward, if appropriate. C<sv_catsv>, C<sv_catsv_nomg>,
+and C<sv_catsv_mg> are implemented in terms of this function.
=cut */
PERL_ARGS_ASSERT_SV_CATSV_FLAGS;
- if (ssv) {
+ if (ssv) {
STRLEN slen;
const char *spv = SvPV_flags_const(ssv, slen, flags);
if (spv) {
- if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
- mg_get(dsv);
+ if (flags & SV_GMAGIC)
+ SvGETMAGIC(dsv);
sv_catpvn_flags(dsv, spv, slen,
DO_UTF8(ssv) ? SV_CATUTF8 : SV_CATBYTES);
- }
+ if (flags & SV_SMAGIC)
+ SvSETMAGIC(dsv);
+ }
}
- if (flags & SV_SMAGIC)
- SvSETMAGIC(dsv);
}
/*
mg->mg_virtual = (MGVTBL *) vtable;
mg_magical(sv);
- if (SvGMAGICAL(sv))
- SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
return mg;
}
/* 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;
}
}
if (cnt < 0)
cnt = 0; /* we do need to re-set the sv even when cnt <= 0 */
if (append)
- sv_catpvn(sv, (char *) buf, cnt);
+ sv_catpvn_nomg(sv, (char *) buf, cnt);
else
- sv_setpvn(sv, (char *) buf, cnt);
+ sv_setpvn(sv, (char *) buf, cnt); /* "nomg" is implied */
if (i != EOF && /* joy */
(!rslen ||
PERL_ARGS_ASSERT_SV_VSETPVFN;
sv_setpvs(sv, "");
- sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
+ sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, 0);
}
/*
=for apidoc sv_vcatpvfn
+=for apidoc sv_vcatpvfn_flags
+
Processes its arguments like C<vsprintf> and appends the formatted output
to an SV. Uses an array of SVs if the C style variable argument list is
missing (NULL). When running with taint checks enabled, indicates via
C<maybe_tainted> if results are untrustworthy (often due to the use of
locales).
+If called as C<sv_vcatpvfn> or flags include C<SV_GMAGIC>, calls get magic.
+
Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
=cut
*/
-
#define VECTORIZE_ARGS vecsv = va_arg(*args, SV*);\
vecstr = (U8*)SvPV_const(vecsv,veclen);\
vec_utf8 = DO_UTF8(vecsv);
Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted)
{
+ PERL_ARGS_ASSERT_SV_VCATPVFN;
+
+ sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
+}
+
+void
+Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
+ va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted,
+ const U32 flags)
+{
dVAR;
char *p;
char *q;
/* large enough for "%#.#f" --chip */
/* what about long double NVs? --jhi */
- PERL_ARGS_ASSERT_SV_VCATPVFN;
+ PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
PERL_UNUSED_ARG(maybe_tainted);
+ if (flags & SV_GMAGIC)
+ SvGETMAGIC(sv);
+
/* no matter what, this is a string now */
- (void)SvPV_force(sv, origlen);
+ (void)SvPV_force_nomg(sv, origlen);
/* special-case "", "%s", and "%-p" (SVf - see below) */
if (patlen == 0)
if (patlen == 2 && pat[0] == '%' && pat[1] == 's') {
if (args) {
const char * const s = va_arg(*args, char*);
- sv_catpv(sv, s ? s : nullstr);
+ sv_catpv_nomg(sv, s ? s : nullstr);
}
else if (svix < svmax) {
- sv_catsv(sv, *svargs);
+ /* we want get magic on the source but not the target. sv_catsv can't do that, though */
+ SvGETMAGIC(*svargs);
+ sv_catsv_nomg(sv, *svargs);
}
else
S_vcatpvfn_missing_argument(aTHX);
if (args && patlen == 3 && pat[0] == '%' &&
pat[1] == '-' && pat[2] == 'p') {
argsv = MUTABLE_SV(va_arg(*args, void*));
- sv_catsv(sv, argsv);
+ sv_catsv_nomg(sv, argsv);
return;
}
if (digits && digits < sizeof(ebuf) - NV_DIG - 10) {
/* 0, point, slack */
Gconvert(nv, (int)digits, 0, ebuf);
- sv_catpv(sv, ebuf);
+ sv_catpv_nomg(sv, ebuf);
if (*ebuf) /* May return an empty string for digits==0 */
return;
}
STRLEN l;
if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
- sv_catpvn(sv, p, l);
+ sv_catpvn_nomg(sv, p, l);
return;
}
}
for (q = p; q < patend && *q != '%'; ++q) ;
if (q > p) {
if (has_utf8 && !pat_utf8)
- sv_catpvn_utf8_upgrade(sv, p, q - p, nsv);
+ sv_catpvn_nomg_utf8_upgrade(sv, p, q - p, nsv);
else
- sv_catpvn(sv, p, q - p);
+ sv_catpvn_nomg(sv, p, q - p);
p = q;
}
if (q++ >= patend)
sv_catpvs(msg, "\"%");
for (f = fmtstart; f < fmtend; f++) {
if (isPRINT(*f)) {
- sv_catpvn(msg, f, 1);
+ sv_catpvn_nomg(msg, f, 1);
} else {
Perl_sv_catpvf(aTHX_ msg,
"\\%03"UVof, (UV)*f & 0xFF);
#define HvAMAGIC_on(hv) (SvFLAGS(hv) |= SVf_AMAGIC)
#define HvAMAGIC_off(hv) (SvFLAGS(hv) &=~ SVf_AMAGIC)
+
+#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
*/
/* 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))
/* ----*/
-#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))
#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)
/* ----*/
#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) \
+ (SvPOK_utf8_nogthink(sv) \
? ((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 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) \
+ (SvPOK_byte_nogthink(sv) \
? ((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 FOOx(): idempotent versions of FOO(). If possible, use a local
* var to evaluate the arg once; failing that, use a global if possible;
#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); })
# 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__ */
# 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)) == \
#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)
#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)
/* Should be named SvCatPVN_utf8_upgrade? */
-#define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \
+#define sv_catpvn_nomg_utf8_upgrade(dsv, sstr, slen, nsv) \
STMT_START { \
if (!(nsv)) \
nsv = newSVpvn_flags(sstr, slen, SVs_TEMP); \
sv_setpvn(nsv, sstr, slen); \
SvUTF8_off(nsv); \
sv_utf8_upgrade(nsv); \
- sv_catsv(dsv, nsv); \
+ sv_catsv_nomg(dsv, nsv); \
} STMT_END
/*
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
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
https://perl5.git.perl.org / perl5.git / commitdiff