From: Yitzchak Scott-Thoennes Date: Thu, 15 Jan 2004 14:10:37 +0000 (-0800) Subject: Re: [perl #24816] Magic vars seem unsure if they are purely numeric X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=891f9566d7fc0fb068ade9d98aed69773e02d39c;p=p5sagit%2Fp5-mst-13.2.git Re: [perl #24816] Magic vars seem unsure if they are purely numeric Message-Id: <20040115221037.GA2392@efn.org> Add sv_2iv_flags() to allow magic to be optionally processed. p4raw-id: //depot/perl@22163 --- diff --git a/doop.c b/doop.c index 6724aca..47d64cb 100644 --- a/doop.c +++ b/doop.c @@ -1135,8 +1135,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */ - lsave = lc = SvPV(left, leftlen); - rsave = rc = SvPV(right, rightlen); + lsave = lc = SvPV_nomg(left, leftlen); + rsave = rc = SvPV_nomg(right, rightlen); len = leftlen < rightlen ? leftlen : rightlen; lensave = len; if ((left_utf || right_utf) && (sv == left || sv == right)) { @@ -1145,7 +1145,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) } else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { STRLEN n_a; - dc = SvPV_force(sv, n_a); + dc = SvPV_force_nomg(sv, n_a); if (SvCUR(sv) < (STRLEN)len) { dc = SvGROW(sv, (STRLEN)(len + 1)); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); diff --git a/embed.fnc b/embed.fnc index 5ec0d10..396f5b7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -697,14 +697,16 @@ p |void |sub_crush_depth|CV* cv Apd |bool |sv_2bool |SV* sv Apd |CV* |sv_2cv |SV* sv|HV** st|GV** gvp|I32 lref Apd |IO* |sv_2io |SV* sv -Apd |IV |sv_2iv |SV* sv +Amb |IV |sv_2iv |SV* sv +Apd |IV |sv_2iv_flags |SV* sv|I32 flags Apd |SV* |sv_2mortal |SV* sv Apd |NV |sv_2nv |SV* sv Amb |char* |sv_2pv |SV* sv|STRLEN* lp Apd |char* |sv_2pvutf8 |SV* sv|STRLEN* lp Apd |char* |sv_2pvbyte |SV* sv|STRLEN* lp Ap |char* |sv_pvn_nomg |SV* sv|STRLEN* lp -Apd |UV |sv_2uv |SV* sv +Amb |UV |sv_2uv |SV* sv +Apd |UV |sv_2uv_flags |SV* sv|I32 flags Apd |IV |sv_iv |SV* sv Apd |UV |sv_uv |SV* sv Apd |NV |sv_nv |SV* sv diff --git a/embed.h b/embed.h index b6a90ad..dd5a05d 100644 --- a/embed.h +++ b/embed.h @@ -968,13 +968,13 @@ #define sv_2bool Perl_sv_2bool #define sv_2cv Perl_sv_2cv #define sv_2io Perl_sv_2io -#define sv_2iv Perl_sv_2iv +#define sv_2iv_flags Perl_sv_2iv_flags #define sv_2mortal Perl_sv_2mortal #define sv_2nv Perl_sv_2nv #define sv_2pvutf8 Perl_sv_2pvutf8 #define sv_2pvbyte Perl_sv_2pvbyte #define sv_pvn_nomg Perl_sv_pvn_nomg -#define sv_2uv Perl_sv_2uv +#define sv_2uv_flags Perl_sv_2uv_flags #define sv_iv Perl_sv_iv #define sv_uv Perl_sv_uv #define sv_nv Perl_sv_nv @@ -3471,13 +3471,13 @@ #define sv_2bool(a) Perl_sv_2bool(aTHX_ a) #define sv_2cv(a,b,c,d) Perl_sv_2cv(aTHX_ a,b,c,d) #define sv_2io(a) Perl_sv_2io(aTHX_ a) -#define sv_2iv(a) Perl_sv_2iv(aTHX_ a) +#define sv_2iv_flags(a,b) Perl_sv_2iv_flags(aTHX_ a,b) #define sv_2mortal(a) Perl_sv_2mortal(aTHX_ a) #define sv_2nv(a) Perl_sv_2nv(aTHX_ a) #define sv_2pvutf8(a,b) Perl_sv_2pvutf8(aTHX_ a,b) #define sv_2pvbyte(a,b) Perl_sv_2pvbyte(aTHX_ a,b) #define sv_pvn_nomg(a,b) Perl_sv_pvn_nomg(aTHX_ a,b) -#define sv_2uv(a) Perl_sv_2uv(aTHX_ a) +#define sv_2uv_flags(a,b) Perl_sv_2uv_flags(aTHX_ a,b) #define sv_iv(a) Perl_sv_iv(aTHX_ a) #define sv_uv(a) Perl_sv_uv(aTHX_ a) #define sv_nv(a) Perl_sv_nv(aTHX_ a) diff --git a/global.sym b/global.sym index b9a65d2..06a29fe 100644 --- a/global.sym +++ b/global.sym @@ -426,6 +426,7 @@ Perl_sv_2bool Perl_sv_2cv Perl_sv_2io Perl_sv_2iv +Perl_sv_2iv_flags Perl_sv_2mortal Perl_sv_2nv Perl_sv_2pv @@ -433,6 +434,7 @@ Perl_sv_2pvutf8 Perl_sv_2pvbyte Perl_sv_pvn_nomg Perl_sv_2uv +Perl_sv_2uv_flags Perl_sv_iv Perl_sv_uv Perl_sv_nv diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 5a1bc57..61e52a1 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2923,6 +2923,15 @@ Only use when you are sure SvIOK is true. See also C. =for hackers Found in file sv.h +=item SvIV_nomg + +Like C but doesn't process magic. + + IV SvIV_nomg(SV* sv) + +=for hackers +Found in file sv.h + =item SvLEN Returns the size of the string buffer in the SV, not including any part @@ -3018,22 +3027,22 @@ which guarantees to evaluate sv only once. =for hackers Found in file sv.h -=item SvNVX +=item SvNVx -Returns the raw value in the SV's NV slot, without checks or conversions. -Only use when you are sure SvNOK is true. See also C. +Coerces the given SV to a double and returns it. Guarantees to evaluate +sv only once. Use the more efficient C otherwise. - NV SvNVX(SV* sv) + NV SvNVx(SV* sv) =for hackers Found in file sv.h -=item SvNVx +=item SvNVX -Coerces the given SV to a double and returns it. Guarantees to evaluate -sv only once. Use the more efficient C otherwise. +Returns the raw value in the SV's NV slot, without checks or conversions. +Only use when you are sure SvNOK is true. See also C. - NV SvNVx(SV* sv) + NV SvNVX(SV* sv) =for hackers Found in file sv.h @@ -3227,21 +3236,21 @@ Like C, but converts sv to utf8 first if necessary. =for hackers Found in file sv.h -=item SvPVx +=item SvPVX -A version of C which guarantees to evaluate sv only once. +Returns a pointer to the physical string in the SV. The SV must contain a +string. - char* SvPVx(SV* sv, STRLEN len) + char* SvPVX(SV* sv) =for hackers Found in file sv.h -=item SvPVX +=item SvPVx -Returns a pointer to the physical string in the SV. The SV must contain a -string. +A version of C which guarantees to evaluate sv only once. - char* SvPVX(SV* sv) + char* SvPVx(SV* sv, STRLEN len) =for hackers Found in file sv.h @@ -3279,6 +3288,15 @@ stringified form becoming C. Handles 'get' magic. =for hackers Found in file sv.h +=item SvPV_nomg + +Like C but doesn't process magic. + + char* SvPV_nomg(SV* sv, STRLEN len) + +=for hackers +Found in file sv.h + =item SvREFCNT Returns the value of the object's reference count. @@ -3480,6 +3498,16 @@ for a version which guarantees to evaluate sv only once. =for hackers Found in file sv.h +=item SvUVx + +Coerces the given SV to an unsigned integer and returns it. Guarantees to +evaluate sv only once. Use the more efficient C otherwise. + + UV SvUVx(SV* sv) + +=for hackers +Found in file sv.h + =item SvUVX Returns the raw value in the SV's UV slot, without checks or conversions. @@ -3490,12 +3518,11 @@ Only use when you are sure SvIOK is true. See also C. =for hackers Found in file sv.h -=item SvUVx +=item SvUV_nomg -Coerces the given SV to an unsigned integer and returns it. Guarantees to -evaluate sv only once. Use the more efficient C otherwise. +Like C but doesn't process magic. - UV SvUVx(SV* sv) + UV SvUV_nomg(SV* sv) =for hackers Found in file sv.h @@ -3540,12 +3567,13 @@ named after the PV if we're a string. =for hackers Found in file sv.c -=item sv_2iv +=item sv_2iv_flags -Return the integer value of an SV, doing any necessary string conversion, -magic etc. Normally used via the C and C macros. +Return the integer value of an SV, doing any necessary string +conversion. If flags includes SV_GMAGIC, does an mg_get() first. +Normally used via the C and C macros. - IV sv_2iv(SV* sv) + IV sv_2iv_flags(SV* sv, I32 flags) =for hackers Found in file sv.c @@ -3643,13 +3671,13 @@ use the macro wrapper C instead. =for hackers Found in file sv.c -=item sv_2uv +=item sv_2uv_flags Return the unsigned integer value of an SV, doing any necessary string -conversion, magic etc. Normally used via the C and C -macros. +conversion. If flags includes SV_GMAGIC, does an mg_get() first. +Normally used via the C and C macros. - UV sv_2uv(SV* sv) + UV sv_2uv_flags(SV* sv, I32 flags) =for hackers Found in file sv.c diff --git a/pp.c b/pp.c index 7ebc7b8..8898735 100644 --- a/pp.c +++ b/pp.c @@ -2204,11 +2204,11 @@ PP(pp_bit_and) if (SvGMAGICAL(right)) mg_get(right); if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = SvIV(left) & SvIV(right); + IV i = SvIV_nomg(left) & SvIV_nomg(right); SETi(i); } else { - UV u = SvUV(left) & SvUV(right); + UV u = SvUV_nomg(left) & SvUV_nomg(right); SETu(u); } } @@ -2229,11 +2229,11 @@ PP(pp_bit_xor) if (SvGMAGICAL(right)) mg_get(right); if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); + IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right); SETi(i); } else { - UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); + UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right); SETu(u); } } @@ -2254,11 +2254,11 @@ PP(pp_bit_or) if (SvGMAGICAL(right)) mg_get(right); if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); + IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right); SETi(i); } else { - UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); + UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right); SETu(u); } } @@ -2357,11 +2357,11 @@ PP(pp_complement) mg_get(sv); if (SvNIOKp(sv)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = ~SvIV(sv); + IV i = ~SvIV_nomg(sv); SETi(i); } else { - UV u = ~SvUV(sv); + UV u = ~SvUV_nomg(sv); SETu(u); } } @@ -2370,7 +2370,7 @@ PP(pp_complement) register I32 anum; STRLEN len; - SvSetSV(TARG, sv); + sv_setsv_nomg(TARG, sv); tmps = (U8*)SvPV_force(TARG, len); anum = len; if (SvUTF8(TARG)) { diff --git a/proto.h b/proto.h index 359c986..ee315bf 100644 --- a/proto.h +++ b/proto.h @@ -667,14 +667,16 @@ PERL_CALLCONV void Perl_sub_crush_depth(pTHX_ CV* cv); PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV* sv); PERL_CALLCONV CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref); PERL_CALLCONV IO* Perl_sv_2io(pTHX_ SV* sv); -PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV* sv); +/* PERL_CALLCONV IV sv_2iv(pTHX_ SV* sv); */ +PERL_CALLCONV IV Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags); PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv); PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv); /* PERL_CALLCONV char* sv_2pv(pTHX_ SV* sv, STRLEN* lp); */ PERL_CALLCONV char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp); PERL_CALLCONV char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp); PERL_CALLCONV char* Perl_sv_pvn_nomg(pTHX_ SV* sv, STRLEN* lp); -PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV* sv); +/* PERL_CALLCONV UV sv_2uv(pTHX_ SV* sv); */ +PERL_CALLCONV UV Perl_sv_2uv_flags(pTHX_ SV* sv, I32 flags); PERL_CALLCONV IV Perl_sv_iv(pTHX_ SV* sv); PERL_CALLCONV UV Perl_sv_uv(pTHX_ SV* sv); PERL_CALLCONV NV Perl_sv_nv(pTHX_ SV* sv); diff --git a/sv.c b/sv.c index db9490a..6e64702 100644 --- a/sv.c +++ b/sv.c @@ -2039,22 +2039,34 @@ S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype) } #endif /* !NV_PRESERVES_UV*/ +/* sv_2iv() is now a macro using Perl_sv_2iv_flags(); + * this function provided for binary compatibility only + */ + +IV +Perl_sv_2iv(pTHX_ register SV *sv) +{ + return sv_2iv_flags(sv, SV_GMAGIC); +} + /* -=for apidoc sv_2iv +=for apidoc sv_2iv_flags -Return the integer value of an SV, doing any necessary string conversion, -magic etc. Normally used via the C and C macros. +Return the integer value of an SV, doing any necessary string +conversion. If flags includes SV_GMAGIC, does an mg_get() first. +Normally used via the C and C macros. =cut */ IV -Perl_sv_2iv(pTHX_ register SV *sv) +Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags) { if (!sv) return 0; if (SvGMAGICAL(sv)) { - mg_get(sv); + if (flags & SV_GMAGIC) + mg_get(sv); if (SvIOKp(sv)) return SvIVX(sv); if (SvNOKp(sv)) { @@ -2336,23 +2348,34 @@ Perl_sv_2iv(pTHX_ register SV *sv) return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv); } +/* sv_2uv() is now a macro using Perl_sv_2uv_flags(); + * this function provided for binary compatibility only + */ + +UV +Perl_sv_2uv(pTHX_ register SV *sv) +{ + return sv_2uv_flags(sv, SV_GMAGIC); +} + /* -=for apidoc sv_2uv +=for apidoc sv_2uv_flags Return the unsigned integer value of an SV, doing any necessary string -conversion, magic etc. Normally used via the C and C -macros. +conversion. If flags includes SV_GMAGIC, does an mg_get() first. +Normally used via the C and C macros. =cut */ UV -Perl_sv_2uv(pTHX_ register SV *sv) +Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags) { if (!sv) return 0; if (SvGMAGICAL(sv)) { - mg_get(sv); + if (flags & SV_GMAGIC) + mg_get(sv); if (SvIOKp(sv)) return SvUVX(sv); if (SvNOKp(sv)) diff --git a/sv.h b/sv.h index b31cb14..332a7f4 100644 --- a/sv.h +++ b/sv.h @@ -854,6 +854,9 @@ C for a version which guarantees to evaluate sv only once. =for apidoc Am|char*|SvPVx|SV* sv|STRLEN len A version of C which guarantees to evaluate sv only once. +=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len +Like C but doesn't process magic. + =for apidoc Am|char*|SvPV_nolen|SV* sv Returns a pointer to the string in the SV, or a stringified form of the SV if the SV does not contain a string. The SV may cache the @@ -863,6 +866,9 @@ stringified form becoming C. Handles 'get' magic. Coerces the given SV to an integer and returns it. See C for a version which guarantees to evaluate sv only once. +=for apidoc Am|IV|SvIV_nomg|SV* sv +Like C but doesn't process magic. + =for apidoc Am|IV|SvIVx|SV* sv Coerces the given SV to an integer and returns it. Guarantees to evaluate sv only once. Use the more efficient C otherwise. @@ -879,6 +885,9 @@ sv only once. Use the more efficient C otherwise. Coerces the given SV to an unsigned integer and returns it. See C for a version which guarantees to evaluate sv only once. +=for apidoc Am|UV|SvUV_nomg|SV* sv +Like C but doesn't process magic. + =for apidoc Am|UV|SvUVx|SV* sv Coerces the given SV to an unsigned integer and returns it. Guarantees to evaluate sv only once. Use the more efficient C otherwise. @@ -942,6 +951,9 @@ scalar. #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) #define SvNV(sv) (SvNOK(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) @@ -1114,6 +1126,8 @@ scalar. #define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0) #define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC) #define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC) +#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC) +#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC) /* Should be named SvCatPVN_utf8_upgrade? */ #define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \ diff --git a/t/op/bop.t b/t/op/bop.t index c433875..d5315a8 100755 --- a/t/op/bop.t +++ b/t/op/bop.t @@ -9,7 +9,7 @@ BEGIN { @INC = '../lib'; } -print "1..44\n"; +print "1..143\n"; # numerics print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n"); @@ -184,3 +184,149 @@ $neg1 = -1.0; print ((~ $neg1 == 0) ? "ok 43\n" : "not ok 43\n"); $neg7 = -7.0; print ((~ $neg7 == 6) ? "ok 44\n" : "not ok 44\n"); + +require "./test.pl"; +curr_test(45); + +# double magic tests + +sub TIESCALAR { bless { value => $_[1], orig => $_[1] } } +sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] } +sub FETCH { $_[0]{fetch}++; $_[0]{value} } +sub stores { tied($_[0])->{value} = tied($_[0])->{orig}; + delete(tied($_[0])->{store}) || 0 } +sub fetches { delete(tied($_[0])->{fetch}) || 0 } + +# numeric double magic tests + +tie $x, "main", 1; +tie $y, "main", 3; + +is(($x | $y), 3); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x & $y), 1); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x ^ $y), 2); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x |= $y), 3); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(($x &= $y), 1); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(($x ^= $y), 2); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(~~$y, 3); +is(fetches($y), 1); +is(stores($y), 0); + +{ use integer; + +is(($x | $y), 3); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x & $y), 1); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x ^ $y), 2); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x |= $y), 3); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(($x &= $y), 1); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(($x ^= $y), 2); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(~$y, -4); +is(fetches($y), 1); +is(stores($y), 0); + +} # end of use integer; + +# stringwise double magic tests + +tie $x, "main", "a"; +tie $y, "main", "c"; + +is(($x | $y), ("a" | "c")); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x & $y), ("a" & "c")); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x ^ $y), ("a" ^ "c")); +is(fetches($x), 1); +is(fetches($y), 1); +is(stores($x), 0); +is(stores($y), 0); + +is(($x |= $y), ("a" | "c")); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(($x &= $y), ("a" & "c")); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(($x ^= $y), ("a" ^ "c")); +is(fetches($x), 2); +is(fetches($y), 1); +is(stores($x), 1); +is(stores($y), 0); + +is(~~$y, "c"); +is(fetches($y), 1); +is(stores($y), 0);