[perl #24816] Magic vars seem unsure if they are purely numeric
perlbug-...@perl.org
# Please include the string: [perl #24816]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=24816 >
This is a bug report for perl from perl-...@ton.iguana.be,
generated with the help of perlbug 1.34 running under perl v5.8.2.
-----------------------------------------------------------------
[Please enter your report here]
(I use $? purely as an example here, things like $= behave the same)
perl -wle 'print $? = $? ^ "3"'
Argument "^C" isn't numeric in scalar assignment at -e line 1.
0
So it seems to fetch $? as the string "0" (why, wasn't $? supposed
to be purely numeric ?), calculates "0" ^ "3", giving "\3" (^C), and then
fails to store that (Ah, so it DOES behave as if purely numeric there).
Almost any use will "fix" this behaviour:
perl -wle 'print $?; print $? = $? ^ "3"'
0
3
Look ma, no warnings !
Using Devel::Peek I see:
perl -wle 'use Devel::Peek; Dump($?); print $?; Dump($?)'
SV = PVMG(0x8195238) at 0x8174868
REFCNT = 1
FLAGS = (GMG,SMG)
IV = 0
NV = 0
PV = 0
MAGIC = 0x818e128
MG_VIRTUAL = &PL_vtbl_sv
MG_TYPE = PERL_MAGIC_sv(\0)
MG_OBJ = 0x81748bc
MG_LEN = 1
MG_PTR = 0x8162ab4 "?"
0
SV = PVMG(0x8195238) at 0x8174868
REFCNT = 1
FLAGS = (GMG,SMG,pIOK,pPOK)
IV = 0
NV = 0
PV = 0x8162828 "0"\0
CUR = 1
LEN = 2
MAGIC = 0x818e128
MG_VIRTUAL = &PL_vtbl_sv
MG_TYPE = PERL_MAGIC_sv(\0)
MG_OBJ = 0x81748bc
MG_LEN = 1
MG_PTR = 0x8162ab4 "?"
I think that the magical purely numeric variables should start with the
integer flag set. Just adding pIOK should probably be enough.
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=low
---
Site configuration information for perl v5.8.2:
Configured by ton at Sun Jan 4 19:19:06 CET 2004.
Summary of my perl5 (revision 5.0 version 8 subversion 2) configuration:
Platform:
osname=linux, osvers=2.6.0, archname=i686-linux-64int-ld
uname='linux quasar 2.6.0 #3 thu dec 18 18:22:48 cet 2003 i686 gnulinux '
config_args=''
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=define use64bitall=undef uselongdouble=define
usemymalloc=y, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -fomit-frame-pointer',
cppflags='-fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='3.4.0 20031231 (experimental)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.3.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'
Locally applied patches:
---
@INC for perl v5.8.2:
/usr/lib/perl5/5.8.2/i686-linux-64int-ld
/usr/lib/perl5/5.8.2
/usr/lib/perl5/site_perl/5.8.2/i686-linux-64int-ld
/usr/lib/perl5/site_perl/5.8.2
/usr/lib/perl5/site_perl
.
---
Environment for perl v5.8.2:
HOME=/home/ton
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/usr/local/bin:/usr/local/sbin:/usr/local/jre/bin:/home/oracle/product/9.0.1/bin:/usr/local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sbin:/bin:/sbin:.
PERL_BADLANG (unset)
SHELL=/bin/bash
Ton Hospel
"perl-...@ton.iguana.be (via RT)" <perlbug-...@perl.org> writes:
> I think that the magical purely numeric variables should start with the
> integer flag set. Just adding pIOK should probably be enough.
Ah, doing Devel::Peek on $= I see that in fact the IV slot isn't
properly filled until a first use, so it also needs to set the value there
besides adding the pIOK flag.
Rafael Garcia-Suarez
> >> perl -wle 'print $? = $? ^ "3"'
> >> Argument "^C" isn't numeric in scalar assignment at -e line 1.
> >> 0
> >> I think that the magical purely numeric variables should start with the
> >> integer flag set. Just adding pIOK should probably be enough.
> >
> > and aren't initialized.
> >
> > Many (but not all) PP functions do something like
> >
> > if (sv && SvGMAGICAL(sv))
> > mg_get(sv);
> >
> > on their arguments before using them to avoid this kind of case.
> > pp_bit_xor() doesn't, adding it solves the bug. However it's not
> > clear to me why some functions do this and some don't -- is there
> > a reason or are there potential bugs in all those functions ?
> > Opinions anyone ?
>
> I was starting to suspect that when I saw that $= intitially nowhere
> contains it's value of 60. I don't think any of the scalar magical
> variables is however particularly expensive to initialize. Would
> it be possible to initialize them all and then drop that mg_get
> for scalar operations ? It would slow down perl startup, but speed up
> runtime.
Not a good solution. First, it's not as easy as it sounds ; secondly,
this fix will not be correct. You'll may be able to figure out an
initial value for $? at interpreter startup, but that won't guarantee
that this value will be correct many statements later, when you'll first
access $?.
Rafael Garcia-Suarez
> perl -wle 'print $? = $? ^ "3"'
> Argument "^C" isn't numeric in scalar assignment at -e line 1.
> 0
> I think that the magical purely numeric variables should start with the
> integer flag set. Just adding pIOK should probably be enough.
But magical variables don't "start" -- they have no symbol table entry
Ton Hospel
Rafael Garcia-Suarez <rgarci...@free.fr> writes:
> perl-...@ton.iguana.be (via RT) wrote:
>> perl -wle 'print $? = $? ^ "3"'
>> Argument "^C" isn't numeric in scalar assignment at -e line 1.
>> 0
>> I think that the magical purely numeric variables should start with the
>> integer flag set. Just adding pIOK should probably be enough.
>
> and aren't initialized.
>
> Many (but not all) PP functions do something like
>
> if (sv && SvGMAGICAL(sv))
> mg_get(sv);
>
> on their arguments before using them to avoid this kind of case.
> pp_bit_xor() doesn't, adding it solves the bug. However it's not
> clear to me why some functions do this and some don't -- is there
> a reason or are there potential bugs in all those functions ?
> Opinions anyone ?
I was starting to suspect that when I saw that $= intitially nowhere
Chip Salzenberg
> Many (but not all) PP functions do something like
>
> if (sv && SvGMAGICAL(sv))
> mg_get(sv);
>
> some don't -- is there a reason or are there potential bugs in all
> those functions ?
I think it's always a potential bug if mg_get() isn't called. OTOH,
many of the common access functions call mg_get() under the covers, so
it happens more than you'd think.
OTGH, some of them call mg_get() only when a desired OK bit isn't set
(e.g. SvIV() -> sv_2iv()). I'd call that a bug too, but a subtler
one. IMO, mg_get() itself is a Bad Thing. Making sure it's called
exactly once in each use case is a never-ending chore.
In Topaz the idea was that an SV access function would return a value
which might (for normal vars) or might not (for magic vars) share some
of the original SV's underlying representation. It provided an event
that would trigger the magic behavior, without leftover state hanging
around to look like normal data. I still like that approach better
than mg_get's: "Fill in your missing contents; I'll pretend they were
always there."
--
Chip Salzenberg - a.k.a. - <ch...@pobox.com>
"I wanted to play hopscotch with the impenetrable mystery of existence,
but he stepped in a wormhole and had to go in early." // MST3K
Rafael Garcia-Suarez
> According to Rafael Garcia-Suarez:
> > Many (but not all) PP functions do something like
> >
> > if (sv && SvGMAGICAL(sv))
> > mg_get(sv);
> >
> > [...] However it's not clear to me why some functions do this and
> > some don't -- is there a reason or are there potential bugs in all
> > those functions ?
>
> I think it's always a potential bug if mg_get() isn't called. OTOH,
> many of the common access functions call mg_get() under the covers, so
> it happens more than you'd think.
OK. A cursory look at the PP functions reveals that pp_bit_and,
pp_bit_xor, pp_bit_or and pp_complement check SvNIOKp on their arguments
without checking for magic beforehand. Now fixed as change #22074.
I haven't detected other problems so far.
H.Merijn Brand
I only have an old bug number: 20020227.005
See line 346 in t/op/write.t
And IIRC there is one related: $= is about maxint in some rare cases
--
H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
using perl-5.6.1, 5.8.0, & 5.9.x, and 806 on HP-UX 10.20 & 11.00, 11i,
AIX 4.3, SuSE 8.2, and Win2k. http://www.cmve.net/~merijn/
http://archives.develooper.com/daily...@perl.org/ per...@perl.org
send smoke reports to: smokers...@perl.org, QA: http://qa.perl.org
Rafael Garcia-Suarez
> > Opinions anyone ?
>
> I only have an old bug number: 20020227.005
> See line 346 in t/op/write.t
one of the TODO tests here was passing for me, so I removed the TODO.
(as the TODO tag wasn't printed on success, this went unnoticed for
an unknown time)
H.Merijn Brand
> On Tue 06 Jan 2004 00:04, Rafael Garcia-Suarez <rgarci...@free.fr> wrote:
> > perl-...@ton.iguana.be (via RT) wrote:
> > > perl -wle 'print $? = $? ^ "3"'
> > > Argument "^C" isn't numeric in scalar assignment at -e line 1.
> > > 0
> > ...
> > > I think that the magical purely numeric variables should start with the
> > > integer flag set. Just adding pIOK should probably be enough.
> >
> > But magical variables don't "start" -- they have no symbol table entry
> > and aren't initialized.
> >
> > Many (but not all) PP functions do something like
> >
> > if (sv && SvGMAGICAL(sv))
> > mg_get(sv);
> >
> > on their arguments before using them to avoid this kind of case.
> > pp_bit_xor() doesn't, adding it solves the bug. However it's not
> > clear to me why some functions do this and some don't -- is there
> > a reason or are there potential bugs in all those functions ?
> > Opinions anyone ?
>
> I only have an old bug number: 20020227.005
> See line 346 in t/op/write.t
http://bugs6.perl.org/rt3/Ticket/Display.html?id=8698
On my backtrack I closed 7878, 9470, and 22088
Dave, can you have another go at 22088?
IIRC There are many related bugs
22088 is still open in blead:
a5:/pro/3gl/CPAN/perl-current 126 > ./perl -Ilib ~/xx.pl
key2 value2
key1 value1
Use of uninitialized value in formline at /u/usr/merijn/xx.pl line 13.
Exit 255
a5:/pro/3gl/CPAN/perl-current 127 > cat ~/xx.pl
#!/pro/bin/perl
use strict;
use warnings;
$SIG{__WARN__} = sub { die "@_" };
my %hash = ( key1 => "value1", key2 => "value2" );
my ($val1, $val2);
format =
@>>>>> @<<<<<<<<<<
$val1, $val2
.
# This is ok
foreach $val1 (keys %hash) {
$val2 = $hash{$val1};
write;
}
print_hash ();
# This isn't
sub print_hash {
foreach $val1 (keys %hash) {
$val2 = $hash{$val1};
write;
}
}
a5:/pro/3gl/CPAN/perl-current 128 >
> And IIRC there is one related: $= is about maxint in some rare cases
cannot find this, nor reproduce at the moment. So either I was still looking
for a reproducable case, and never filed a bug report, or it got lost in the
pile of work
Nick Ing-Simmons
There are macros that include that kind of stuff these days,
so some non-users may be using via macros.
Other non-uses are probably to avoid calling mg_get() multiple times.
But I suspect there are some whoops we forgot type bugs as well.
>Opinions anyone ?
Yitzchak Scott-Thoennes
I believe pp_bit_xor and the others Rafael patched fall into the
"avoid calling mg_get() multiple times" case. I'll try to come up
with test cases that trigger double magic. One fix would be to have
the mg_get at the top and call new functions sv_2[iu]v_flags. (I
haven't looked at do_vop yet, but I bet there is double magic on that
path also.)
Yitzchak Scott-Thoennes
There is indeed double magic in every case now. Here's what I've got
so far. Now to implement SvIV_nomg and SvUV_nomg, I have a question.
Would it be better to change sv_2[iu]v to sv_2[iu]v_flags as sv_2pv works
or just have a simple _nomg version that doesn't cache the IV/UV and
expects AMAGIC to have already been handled, etc. Something like:
SvIOKp(sv) yields SvIVX(sv), otherwise
SvNOKp(sv) yields I_V(SvNVX(sv), otherwise
SvROK(sv) yields PTR2IV(SvRV(sv), otherwise
SvPOKp(sv) && SvLEN(sv) yields ...grok_number..., otherwise
..report_uninit...
--- perl/doop.c.orig 2003-12-15 01:33:01.000000000 -0800
+++ perl/doop.c 2004-01-06 13:42:44.772123200 -0800
@@ -1106,8 +1106,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV
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)) {
--- perl/pp.c.orig 2004-01-05 15:51:29.000000000 -0800
+++ perl/pp.c 2004-01-06 15:21:27.558672000 -0800
@@ -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)) {
End of Patch.
h...@crypt.org
:There is indeed double magic in every case now. Here's what I've got
:so far. Now to implement SvIV_nomg and SvUV_nomg, I have a question.
:
:Would it be better to change sv_2[iu]v to sv_2[iu]v_flags as sv_2pv works
:or just have a simple _nomg version that doesn't cache the IV/UV and
:expects AMAGIC to have already been handled, etc. Something like:
:
:SvIOKp(sv) yields SvIVX(sv), otherwise
:SvNOKp(sv) yields I_V(SvNVX(sv), otherwise
:SvROK(sv) yields PTR2IV(SvRV(sv), otherwise
:SvPOKp(sv) && SvLEN(sv) yields ...grok_number..., otherwise
:..report_uninit...
I feel reasonably confident that an approach parallel to sv_2pv would
do what we need. I'm not sure what the impact would be of the _nomg
approach - can we be sure that it will allow us safely to replace
sv_2iv with sv_2iv_nomg each time we detect a double mg_get?
The other thing I worry about is code duplication, with it's attendant
impact on future maintenance.
The downside of the _flags approach is the potential speed hit, but that
should be minimal even in the worst case and zero in the best case.
Hugo
Yitzchak Scott-Thoennes
Ok, here it is. I haven't messed with embed.fnc before (or at least it's
been a long time) so I'd appreciate some eyeballing.
The SvPV_force change in do_vop fixes an existing bug in the result of
stringwise assignment bitops on magic vars:
$ perl5.8.3 -MTie::Scalar -we'tie $x,"Tie::StdScalar";
$x = "a"; $x |= "a"; print($x eq "a" ? "ok":"nok")'
nok
(as well as doing extra mg_get on $x). Does it look ok?
The rest just fixes the double magic problems caused by #22074. If this and
that aren't going into maint, the existing bug should be fixed in a separate
patch & test.
Should I add a SvNV_nomg/sv_2nv_flags just for consistency? Nothing needs it
that I know of.
diff -urp perl/doop.c perlpatch/doop.c
--- perl/doop.c 2004-01-12 09:48:03.000000000 -0800
+++ perlpatch/doop.c 2004-01-15 11:44:08.319177600 -0800
@@ -1112,8 +1112,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV
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)) {
@@ -1122,7 +1122,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV
}
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 -urp perl/embed.fnc perlpatch/embed.fnc
--- perl/embed.fnc 2004-01-06 11:17:40.000000000 -0800
+++ perlpatch/embed.fnc 2004-01-15 11:44:08.489422400 -0800
@@ -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 -urp perl/pp.c perlpatch/pp.c
--- perl/pp.c 2004-01-05 15:51:29.000000000 -0800
+++ perlpatch/pp.c 2004-01-15 11:44:08.589566400 -0800
diff -urp perl/sv.c perlpatch/sv.c
--- perl/sv.c 2004-01-10 12:36:06.000000000 -0800
+++ perlpatch/sv.c 2004-01-15 11:44:08.699724800 -0800
@@ -2039,22 +2039,34 @@ S_sv_2iuv_non_preserve(pTHX_ register SV
}
#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<SvIV(sv)> and C<SvIVx(sv)> 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<SvIV(sv)> and C<SvIVx(sv)> 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<SvUV(sv)> and C<SvUVx(sv)>
-macros.
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> 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 -urp perl/sv.h perlpatch/sv.h
--- perl/sv.h 2003-12-22 15:39:45.000000000 -0800
+++ perlpatch/sv.h 2004-01-15 11:44:08.809883200 -0800
@@ -854,6 +854,9 @@ C<SvPVx> for a version which guarantees
=for apidoc Am|char*|SvPVx|SV* sv|STRLEN len
A version of C<SvPV> which guarantees to evaluate sv only once.
+=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len
+Like C<SvPV> 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<SvPOK>. Han
Coerces the given SV to an integer and returns it. See C<SvIVx> for a
version which guarantees to evaluate sv only once.
+=for apidoc Am|IV|SvIV_nomg|SV* sv
+Like C<SvIV> 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<SvIV> otherwise.
@@ -879,6 +885,9 @@ sv only once. Use the more efficient C<S
Coerces the given SV to an unsigned integer and returns it. See C<SvUVx>
for a version which guarantees to evaluate sv only once.
+=for apidoc Am|UV|SvUV_nomg|SV* sv
+Like C<SvUV> 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<SvUV> 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 -urp perl/t/op/bop.t perlpatch/t/op/bop.t
--- perl/t/op/bop.t 2001-03-29 06:21:18.000000000 -0800
+++ perlpatch/t/op/bop.t 2004-01-15 11:44:09.060243200 -0800
@@ -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);
Dave Mitchell
This bug (and others like it) all boil down to the following simple
example:
my $x = 1;
sub p { print "x=$x\n" }
for $x (2,3,4) { p }
which to the suprise of many, outputs:
x=1
x=1
x=1
rather than 2,3,4
Whether you regard it as a bug depends to a certain extent on your
philosophical attitutes towards closures. In the above, p() is a simple
closure, because it makes use of an outer lexical variable: $x in this
case. Perl treats p() and the main program as two independent subs, each of
which have a variable called $x, and which both currently happen to be
aliased to the same value (hence the closure). While the for loop is in
progress, main's $x is instead aliased to the list values, while p()'s $x
continues being aliased to the SV(1).
If lexical vars could be accessed like package vars, then the behaviour of
the above code could be expressed something like:
$MAIN::x = 1;
BEGIN { *P::x = \$MAIN::x } # create the closure at compile time
sub p { print "x=$P::x\n" }
for $MAIN::x (2,3,4) { p }
which also outputs three 1's.
To change the behaviour would be very hard, and I can't think of an
efficient way of doing it
Dave.
> > And IIRC there is one related: $= is about maxint in some rare cases
>
> cannot find this, nor reproduce at the moment. So either I was still looking
> for a reproducable case, and never filed a bug report, or it got lost in the
> pile of work
That's the one that's now being discussed in a separate thread.
--
"Foul and greedy Dwarf - you have eaten the last candle."
-- "Hoardes of the Things", BBC Radio.