Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

[perl #20933] \substr reuses lvalues (sometimes)

3 views
Skip to first unread message

Joshua B.Jore

unread,
Feb 13, 2003, 3:13:46 PM2/13/03
to bugs-bi...@netlabs.develooper.com
# New Ticket Created by Joshua b. Jore
# Please include the string: [perl #20933]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=20933 >


This is a bug report for perl from jo...@lavendergreens.org,
generated with the help of perlbug 1.33 running under perl v5.6.1.


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

The following code prints "abbb" when it should be "abab". BrowserUK
of perlmonks.org clued me into this error.

$s = "ab";
$r[0] = \ substr $s, 0, 1;
$r[1] = \ substr $s, 1, 1;
print ${ $r[0] };
print ${ $r[1] };

$r[$_] = \ substr $s, $_, 1 for (0, 1);
print ${ $r[0] };
print ${ $r[1] };

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=low
---
Site configuration information for perl v5.6.1:

Configured by root at Mon Feb 3 03:46:05 CST 2003.

Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
Platform:
osname=openbsd, osvers=3.2, archname=i386-openbsd
uname='openbsd'
config_args='-Dopenbsd_distribution=defined -dsE'
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
Compiler:
cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include',
optimize='-O2',
cppflags='-fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='2.95.3 20010125 (prerelease)', gccosandvers='openbsd3.2'
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=4, usemymalloc=n, prototype=define
Linker and Libraries:
ld='cc', ldflags =''
libpth=/usr/lib
libs=-lm -lc -lutil
perllibs=-lm -lc -lutil
libc=/usr/lib/libc.so.28.5, so=so, useshrplib=true, libperl=libperl.so.6.1
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=define, ccdlflags='-Wl,-R/usr/libdata/perl5/i386-openbsd/5.6.1/CORE'
cccdlflags='-DPIC -fPIC ', lddlflags='-shared -fPIC '

Locally applied patches:


---
@INC for perl v5.6.1:
/usr/libdata/perl5/i386-openbsd/5.6.1
/usr/local/libdata/perl5/i386-openbsd/5.6.1
/usr/libdata/perl5
/usr/local/libdata/perl5
/usr/local/libdata/perl5/site_perl/i386-openbsd
/usr/libdata/perl5/site_perl/i386-openbsd
/usr/local/libdata/perl5/site_perl
/usr/libdata/perl5/site_perl
/usr/local/lib/perl5/site_perl
.

---
Environment for perl v5.6.1:
HOME=/home/josh
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/usr/bin:/bin:/usr/sbin:/sbin:/usr/X11R6/bin:/usr/local/bin
PERL_BADLANG (unset)
SHELL=/bin/ksh


Slaven Rezic

unread,
Feb 14, 2003, 6:14:57 AM2/14/03
to perl5-...@perl.org, bugs-bi...@netlabs.develooper.com
"Joshua b.Jore (via RT)" <perlbug-...@perl.org> writes:

> # New Ticket Created by Joshua b. Jore
> # Please include the string: [perl #20933]
> # in the subject line of all future correspondence about this issue.
> # <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=20933 >
>
>
> This is a bug report for perl from jo...@lavendergreens.org,
> generated with the help of perlbug 1.33 running under perl v5.6.1.
>
>
> -----------------------------------------------------------------
> [Please enter your report here]
>
> The following code prints "abbb" when it should be "abab". BrowserUK
> of perlmonks.org clued me into this error.
>
> $s = "ab";
> $r[0] = \ substr $s, 0, 1;
> $r[1] = \ substr $s, 1, 1;
> print ${ $r[0] };
> print ${ $r[1] };
>
> $r[$_] = \ substr $s, $_, 1 for (0, 1);
> print ${ $r[0] };
> print ${ $r[1] };
>

The patch below fixes the problem. The fix is not very elegant,
though.

--- bleedperl/pp.c Sun Feb 2 18:59:19 2003
+++ bleedperl2/pp.c Fri Feb 14 11:13:40 2003
@@ -476,6 +476,17 @@ S_refto(pTHX_ SV *sv)
}
else if (SvPADTMP(sv) && !IS_PADGV(sv))
sv = newSVsv(sv);
+ else if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'x') {
+ /* [perl #20933] */
+ SV* new_sv = newSVsv(sv);
+ sv_upgrade(new_sv, SVt_PVLV);
+ sv_magic(new_sv, Nullsv, PERL_MAGIC_substr, Nullch, 0);
+ LvTYPE(new_sv) = 'x';
+ LvTARG(new_sv) = SvREFCNT_inc(LvTARG(sv));
+ LvTARGOFF(new_sv) = LvTARGOFF(sv);
+ LvTARGLEN(new_sv) = LvTARGLEN(sv);
+ sv = new_sv;
+ }
else {
SvTEMP_off(sv);
(void)SvREFCNT_inc(sv);
--- bleedperl/t/op/substr.t Wed Mar 21 02:18:37 2001
+++ bleedperl2/t/op/substr.t Fri Feb 14 09:53:01 2003
@@ -1,6 +1,6 @@
#!./perl

-print "1..174\n";
+print "1..175\n";

#P = start of string Q = start of substr R = end of substr S = end of string

@@ -585,3 +585,10 @@ ok 173, $x eq "\xFFb\x{100}\x{200}";
substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
ok 174, $x eq "\x{100}\x{200}\xFFb";

+# [perl #20933]
+{
+ my $s = "ab";
+ my @r;
+ $r[$_] = \ substr $s, $_, 1 for (0, 1);
+ ok 175, join("", map { $$_ } @r) eq "ab";
+}

--
Slaven Rezic - sla...@rezic.de

tktimex - project time manager
http://sourceforge.net/projects/ptktools/

Dave Mitchell

unread,
Feb 14, 2003, 7:51:25 AM2/14/03
to Slaven Rezic, perl5-...@perl.org

You will need a similar fix for vec (LvTYPE == 'v') too.

Perhaps an alternative approach would be for substr and vec in an lvalue
context, to return a new mortal rather than using TARG?

--
A walk of a thousand miles begins with a single step...
then continues for another 1,999,999 or so.

Slaven Rezic

unread,
Feb 14, 2003, 2:23:20 PM2/14/03
to Dave Mitchell, perl5-...@perl.org
Dave Mitchell <da...@fdgroup.com> writes:

> On Fri, Feb 14, 2003 at 12:14:57PM +0100, Slaven Rezic wrote:
> > "Joshua b.Jore (via RT)" <perlbug-...@perl.org> writes:
> > > The following code prints "abbb" when it should be "abab". BrowserUK
> > > of perlmonks.org clued me into this error.
> > >
> > > $s = "ab";
> > > $r[0] = \ substr $s, 0, 1;
> > > $r[1] = \ substr $s, 1, 1;
> > > print ${ $r[0] };
> > > print ${ $r[1] };
> > >
> > > $r[$_] = \ substr $s, $_, 1 for (0, 1);
> > > print ${ $r[0] };
> > > print ${ $r[1] };
> > >
> >
> > The patch below fixes the problem. The fix is not very elegant,
> > though.
> >
> > --- bleedperl/pp.c Sun Feb 2 18:59:19 2003
> > +++ bleedperl2/pp.c Fri Feb 14 11:13:40 2003

[...]


>
> You will need a similar fix for vec (LvTYPE == 'v') too.

Below is a revised patch.

>
> Perhaps an alternative approach would be for substr and vec in an lvalue
> context, to return a new mortal rather than using TARG?
>

--- bleedperl/pp.c Sun Feb 2 18:59:19 2003
+++ bleedperl2/pp.c Fri Feb 14 19:40:10 2003
@@ -476,6 +476,19 @@ S_refto(pTHX_ SV *sv)


}
else if (SvPADTMP(sv) && !IS_PADGV(sv))
sv = newSVsv(sv);

+ else if (SvTYPE(sv) == SVt_PVLV && (LvTYPE(sv) == 'x' || LvTYPE(sv) == 'v')) {


+ /* [perl #20933] */
+ SV* new_sv = newSVsv(sv);
+ sv_upgrade(new_sv, SVt_PVLV);
+ sv_magic(new_sv, Nullsv,

+ (LvTYPE(sv) == 'x' ? PERL_MAGIC_substr : PERL_MAGIC_vec),
+ Nullch, 0);
+ LvTYPE(new_sv) = LvTYPE(sv);


+ LvTARG(new_sv) = SvREFCNT_inc(LvTARG(sv));
+ LvTARGOFF(new_sv) = LvTARGOFF(sv);
+ LvTARGLEN(new_sv) = LvTARGLEN(sv);
+ sv = new_sv;
+ }
else {
SvTEMP_off(sv);
(void)SvREFCNT_inc(sv);

--- bleedperl/t/op/substr.t Wed Mar 21 02:18:37 2001
+++ bleedperl2/t/op/substr.t Fri Feb 14 09:53:01 2003
@@ -1,6 +1,6 @@
#!./perl

-print "1..174\n";
+print "1..175\n";

#P = start of string Q = start of substr R = end of substr S = end of string

@@ -585,3 +585,10 @@ ok 173, $x eq "\xFFb\x{100}\x{200}";
substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
ok 174, $x eq "\x{100}\x{200}\xFFb";

+# [perl #20933]
+{
+ my $s = "ab";
+ my @r;
+ $r[$_] = \ substr $s, $_, 1 for (0, 1);
+ ok 175, join("", map { $$_ } @r) eq "ab";
+}

--- bleedperl/t/op/vec.t Wed Feb 27 01:56:06 2002
+++ bleedperl2/t/op/vec.t Fri Feb 14 19:40:34 2003


@@ -1,6 +1,6 @@
#!./perl

-print "1..30\n";
+print "1..31\n";

my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;

@@ -86,3 +86,14 @@ print "ok 29\n";
vec(substr($foo, 1,3), 5, 4) = 3;
print "not " if $foo ne "\x61\x62\x63\x34\x65\x66";
print "ok 30\n";
+
+# A variation of [perl #20933]
+{
+ my $s = "";
+ vec($s, 0, 1) = 0;
+ vec($s, 1, 1) = 1;
+ my @r;
+ $r[$_] = \ vec $s, $_, 1 for (0, 1);
+ print "not " if (${ $r[0] } != 0 || ${ $r[1] } != 1);
+ print "ok 31\n";
+}

--
Slaven Rezic - sla...@rezic.de

BBBike - route planner for cyclists in Berlin
WWW version: http://www.bbbike.de
Perl/Tk version for Unix and Windows: http://bbbike.sourceforge.net

Dave Mitchell

unread,
Feb 14, 2003, 5:48:27 PM2/14/03
to Slaven Rezic, perl5-...@perl.org

How about the following alternative? Rather than adding code the
(relatively) hot S_refto, it fixes pp_substr and pp_vec directly.

Dave.


--- pp.c- Fri Feb 14 22:51:50 2003
+++ pp.c Fri Feb 14 22:36:12 2003
@@ -3094,6 +3094,8 @@ PP(pp_substr)
sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
}

+ if (SvREFCNT(TARG) > 1) /* don't share the TARG (#20933) */
+ TARG = sv_newmortal();
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
@@ -3124,6 +3126,8 @@ PP(pp_vec)

SvTAINTED_off(TARG); /* decontaminate */
if (lvalue) { /* it's an lvalue! */
+ if (SvREFCNT(TARG) > 1) /* don't share the TARG (#20933) */
+ TARG = sv_newmortal();
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);

Slaven Rezic

unread,
Feb 14, 2003, 6:02:04 PM2/14/03
to Dave Mitchell, perl5-...@perl.org
Dave Mitchell <da...@fdgroup.com> writes:

Yes, this looks much cleaner to me.

Regards,
Slaven

> Dave.
>
>
> --- pp.c- Fri Feb 14 22:51:50 2003
> +++ pp.c Fri Feb 14 22:36:12 2003
> @@ -3094,6 +3094,8 @@ PP(pp_substr)
> sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
> }
>
> + if (SvREFCNT(TARG) > 1) /* don't share the TARG (#20933) */
> + TARG = sv_newmortal();
> if (SvTYPE(TARG) < SVt_PVLV) {
> sv_upgrade(TARG, SVt_PVLV);
> sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
> @@ -3124,6 +3126,8 @@ PP(pp_vec)
>
> SvTAINTED_off(TARG); /* decontaminate */
> if (lvalue) { /* it's an lvalue! */
> + if (SvREFCNT(TARG) > 1) /* don't share the TARG (#20933) */
> + TARG = sv_newmortal();
> if (SvTYPE(TARG) < SVt_PVLV) {
> sv_upgrade(TARG, SVt_PVLV);
> sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
>

--
Slaven Rezic - sla...@rezic.de

Berlin Perl Mongers - http://berliner.pm.org

h...@crypt.org

unread,
Feb 15, 2003, 2:38:56 AM2/15/03
to Slaven Rezic, perl5-...@perl.org
Dave Mitchell <da...@fdgroup.com> wrote:
:How about the following alternative? Rather than adding code the

:(relatively) hot S_refto, it fixes pp_substr and pp_vec directly.

Thanks, applied as #18705 with Slaven's tests.

Hugo

0 new messages