Magic vars seem unsure if they are purely numeric

Migrated from rt.perl.org#24816 (status was 'resolved')

Searchable as RT24816$

From perl-5.8.0@ton.iguana.be

Created by perl-5.8.0@ton.iguana.be

(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.

Perl Info

``` 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 ```

From perl5-porters@ton.iguana.be

In article \rt\-3\.0\.8\-24816\-69523\.13\.5221943075889@perl\.org\, "perl-5.8.0@ton.iguana.be (via RT)" \perlbug\-followup@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.

[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

The RT System itself - Status changed from 'new' to 'open'

From @rgs

perl-5.8.0@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 ?

From perl5-porters@ton.iguana.be

In article \20040106000434\.1a5a3770\.rgarciasuarez@\_ree\.\_r\, Rafael Garcia-Suarez \rgarciasuarez@free\.fr writes:

perl-5.8.0@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 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.

From @rgs

Ton Hospel 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 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 $?.

From @chipdude

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.

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. - \chip@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

From @rgs

Chip Salzenberg wrote:

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.

@rgs - Status changed from 'open' to 'resolved'

From @tux

On Tue 06 Jan 2004 00:04\, Rafael Garcia-Suarez \rgarciasuarez@free\.fr wrote:

perl-5.8.0@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

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-build@perl.org/ perl-qa@perl.org send smoke reports to: smokers-reports@perl.org\, QA: http://qa.perl.org

From @rgs

H.Merijn Brand wrote:

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)

And IIRC there is one related: $= is about maxint in some rare cases

From @tux

On Tue 06 Jan 2004 02:02\, "H.Merijn Brand" \h\.m\.brand@hccnet\.nl wrote:

On Tue 06 Jan 2004 00:04\, Rafael Garcia-Suarez \rgarciasuarez@free\.fr wrote:
perl-5.8.0@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

From nick.ing-simmons@elixent.com

Rafael Garcia-Suarez \rgarciasuarez@free\.fr writes:

perl-5.8.0@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 ?

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 ?

From @ysth

On Tue\, Jan 06\, 2004 at 12:02:10PM +0000\, Nick Ing-Simmons \nick\.ing\-simmons@elixent\.com wrote:

Rafael Garcia-Suarez \rgarciasuarez@free\.fr writes:

perl-5.8.0@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 ?

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 ?

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.)

From @ysth

On Tue\, Jan 06\, 2004 at 11:20:56AM -0800\, Yitzchak Scott-Thoennes \sthoenna@efn\.org wrote:

On Tue\, Jan 06\, 2004 at 12:02:10PM +0000\, Nick Ing-Simmons \nick\.ing\-simmons@elixent\.com wrote:

Rafael Garcia-Suarez \rgarciasuarez@free\.fr writes:

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 ?

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 ?

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.)

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...

Inline Patch

```diff --- 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. ```

From @hvds

Yitzchak Scott-Thoennes \sthoenna@efn\.org wrote: :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

From @ysth

On Wed\, Jan 07\, 2004 at 02:39:43PM +0000\, hv@crypt.org wrote:

Yitzchak Scott-Thoennes \sthoenna@efn\.org wrote: :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.

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.

Inline Patch

```diff 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 @@ -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 -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 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 -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 for a version which guarantees =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. Han 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 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 -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); ```

From @iabyn

On Tue\, Jan 06\, 2004 at 09:44:05AM +0100\, H.Merijn Brand wrote:

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 >

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.

Perl / perl5