persistant sideffect involving bitwise xor and substr

[p5pRT]

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

Searchable as RT23207$

[p5pRT]

From va0hs001@sneakemail.com

Created by zmcj0g5a001@sneakemail.com

The bug is clearly demonstrate by the following snippet. The first call to swap() gives the correct result. A second call results in a completely different result despite that there *should* be no connection between the operands of the two calls.

Somehow\, the first call leaves the internal state of perl such that a second call with entirely different parameters\, is affected. Comment out the first call\, and the second call functions as desired.

\

The bug has been verified as present under 5.8 on linux as well as AS 5.8.

#! perl -slw use strict;

sub swab{   substr( $_[0]\, $_[1]\, 1 ) ^=   substr( $_[0]\, $_[2]\, 1 ) ^=   substr( $_[0]\, $_[1]\, 1 ) ^=   substr( $_[0]\, $_[2]\, 1 ) }

my $s ='AB'; swab( $s\, 0\, 1 ); print "'$s'"; print "'$s'";

my $t ='AB'; print "'$t'"; swab( $t\, 0\, 1 ); print "'$t'"; print "'$t'";

__END__ P​:\test>junk 'BA' 'BA' 'AB' ' A' ' A'

Perl Info

``` Flags: category=core severity=high Site configuration information for perl v5.8.0: Configured by ActiveState at Fri Nov 8 00:53:50 2002. Summary of my perl5 (revision 5 version 8 subversion 0) configuration: Platform: osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread uname='' config_args='undef' hint=recommended, useposix=true, d_sigaction=undef usethreads=undef use5005threads=undef useithreads=define usemultiplicity=define useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cl', ccflags ='-nologo -Gf -W3 -MD -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX', optimize='-MD -DNDEBUG -O1', cppflags='-DWIN32' ccversion='', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='link', ldflags ='-nologo -nodefaultlib -release -libpath:"D:/Perl\lib\CORE" -machine:x86' libpth="D:\Perl\lib\CORE" libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib gnulibc_version='undef' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -release -libpath:"D:/Perl\lib\CORE" -machine:x86' Locally applied patches: ACTIVEPERL_LOCAL_PATCHES_ENTRY @INC for perl v5.8.0: d:/Perl/lib d:/Perl/site/lib . Environment for perl v5.8.0: HOME (unset) LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=d:\perl\bin; PERL_BADLANG (unset) SHELL (unset) _________________________________________________________________ It's fast, it's easy and it's free. Get MSN Messenger today! http://www.msn.co.uk/messenger ```

[p5pRT]

From @abigail

On Sun\, Aug 03\, 2003 at 04​:36​:22AM -0000\, va0hs001@​sneakemail.com (via RT) wrote​:

# New Ticket Created by va0hs001@​sneakemail.com # Please include the string​: [perl #23207] # in the subject line of all future correspondence about this issue. # \<URL​: http​://rt.perl.org/rt2/Ticket/Display.html?id=23207 >

This is a bug report for perl from zmcj0g5a001@​sneakemail.com\, generated with the help of perlbug 1.34 running under perl v5.8.0.

----------------------------------------------------------------- [Please enter your report here]

The bug is clearly demonstrate by the following snippet. The first call to swap() gives the correct result. A second call results in a completely different result despite that there *should* be no connection between the operands of the two calls.

Somehow\, the first call leaves the internal state of perl such that a second call with entirely different parameters\, is affected. Comment out the first call\, and the second call functions as desired.

\

The bug has been verified as present under 5.8 on linux as well as AS 5.8.

#! perl -slw use strict;

sub swab{ substr( $_[0]\, $_[1]\, 1 ) ^= substr( $_[0]\, $_[2]\, 1 ) ^= substr( $_[0]\, $_[1]\, 1 ) ^= substr( $_[0]\, $_[2]\, 1 ) }

my $s ='AB'; swab( $s\, 0\, 1 ); print "'$s'"; print "'$s'";

my $t ='AB'; print "'$t'"; swab( $t\, 0\, 1 ); print "'$t'"; print "'$t'";

__END__ P​:\test>junk 'BA' 'BA' 'AB' ' A' ' A'

It seems to be doing this at least from version 5.005\, and still present in bleadperl and 5.8.1-RC4. However\, I don't get " A" as a result\, but "\x00A".

Abigail

[p5pRT]

From enache@rdslink.ro

Please try the patch below.

Basically\, the targets of the substr OPs point to same SVs - and their SvPOK flags are not cleared after use. The second time the swab sub is run\, they'll show up as valid string scalars and won't trigger their magic get method in doop​:1111​::Perl_do_vop.

  lsave = lc = SvPV(left\, leftlen);

Regards\, Adi

Inline Patch

```diff --- /arc/bleadperl/pp.c Tue Jul 29 16:11:50 2003 +++ ./pp.c Sun Aug 3 17:17:59 2003 @@ -3110,7 +3110,8 @@ if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0); - } + } else + SvOK_off(TARG); LvTYPE(TARG) = 'x'; if (LvTARG(TARG) != sv) { --- /arc/bleadperl/t/op/substr.t 2003-02-15 09:37:09.000000000 +0200 +++ ./t/op/substr.t 2003-08-03 17:46:49.000000000 +0300 @@ -1,6 +1,6 @@ #!./perl -print "1..175\n"; +print "1..176\n"; #P = start of string Q = start of substr R = end of substr S = end of string @@ -592,3 +592,13 @@ $r[$_] = \ substr $s, $_, 1 for (0, 1); ok 175, join("", map { $$_ } @r) eq "ab"; } + +# [perl #23207] +{ + sub ss { + substr($_[0],0,1) ^= substr($_[0],1,1) ^= + substr($_[0],0,1) ^= substr($_[0],1,1); + } + my $x = my $y = 'AB'; ss $x; ss $y; + ok 176, $x eq $y; +} ```

[p5pRT]

From @rgs

Enache Adrian wrote​:

Please try the patch below.

Basically\, the targets of the substr OPs point to same SVs - and their SvPOK flags are not cleared after use. The second time the swab sub is run\, they'll show up as valid string scalars and won't trigger their magic get method in doop​:1111​::Perl_do_vop.

Thanks\, applied as #20462.

[p5pRT]

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