Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Assigning value of an op on an SV to said SV somtimes fails #458

Closed
p5pRT opened this issue Aug 30, 1999 · 5 comments
Closed

Assigning value of an op on an SV to said SV somtimes fails #458

p5pRT opened this issue Aug 30, 1999 · 5 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 30, 1999

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

Searchable as RT1299$

@p5pRT
Copy link
Author

p5pRT commented Aug 30, 1999

From cloos@adamsmith.ai

This works in 5.005_03, but fails in certain complex scripts in 5.005_6[01]​:

after code of the form​:

my $f = "foo";
my $l = length($f);
$f = join(',', $l, $f);

$f usually -- and always in this simple example -- holds "3,foo".
Sometimes, however, $f ends up looking like "3,3," instead.

Presumably, sometimes $l and the first delimiter get assigned to $f before
join() reads in $f. Usually, however, join() reads in $f before its result
get's assigned to $f.

The script where this shows up does use IO​::File, IO​::Socket and POSIX, if
that makes any difference.

So, is it a bug in 5.005_6[01] or is just a assignment undefined behavior?

Perl Info


Site configuration information for perl 5.00561:

Configured by cloos at Mon Aug 30 13:47:34 AST 1999.

Summary of my perl5 (revision 5.0 version 5 subversion 61) configuration:
  Platform:
    osname=linux, osvers=2.2.12, archname=i686-linux
    uname='linux adamsmith.ai 2.2.12 #1 smp sun aug 22 13:33:11 ast 1999 i686 unknown '
    config_args='-des -Uinstallusrbinperl -Uuse64bits -Dprefix=/opt/Perl500561'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useperlio=undef d_sfio=undef
    use64bits=undef usemultiplicity=undef
  Compiler:
    cc='cc', optimize='-O2', gccversion=egcs-2.91.66 19990314/Linux (egcs-1.1.2 release)
    cppflags='-Dbool=char -DHAS_BOOL -I/usr/local/include'
    ccflags ='-Dbool=char -DHAS_BOOL -I/usr/local/include'
    stdchar='char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=/lib/libc-2.1.1.so, so=so, useshrplib=false, libperl=libperl.a
  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 5.00561:
    /home/cloos/Systemics/src/r/ric56/blib/arch/auto
    /home/cloos/Systemics/src/r/ric56/blib/arch
    /home/cloos/Systemics/src/r/ric56/blib/lib/auto
    /home/cloos/Systemics/src/r/ric56/blib/lib
    /opt/Perl500561/lib/perl5/5.00561/i686-linux
    /opt/Perl500561/lib/perl5/5.00561
    /opt/Perl500561/lib/site_perl/5.00561/i686-linux
    /opt/Perl500561/lib/site_perl
    .


Environment for perl 5.00561:
    HOME=/home/cloos
    LANG=ga
    LANGUAGE (unset)
    LC_ALL=ga_IE
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/cloos/Systemics/src/r/ric56/blib/script:/home/cloos/bin:/usr/local/sbin:/usr/sbin:/sbin:/usr/local/bin:/usr/X11R6/bin:/usr/bin:/bin
    PERLLIB=/home/cloos/Systemics/src/r/ric56/blib/arch/auto:/home/cloos/Systemics/src/r/ric56/blib/arch:/home/cloos/Systemics/src/r/ric56/blib/lib/auto:/home/cloos/Systemics/src/r/ric56/blib/lib
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Aug 31, 1999

From [Unknown Contact. See original ticket]

James H. Cloos Jr. writes​:

This is a bug report for perl from cloos@​jhcloos.com,
generated with the help of perlbug 1.27 running under perl 5.00561.

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

This works in 5.005_03, but fails in certain complex scripts in 5.005_6[01]​:

after code of the form​:

my $f = "foo";
my $l = length($f);
$f = join(',', $l, $f);

$f usually -- and always in this simple example -- holds "3,foo".
Sometimes, however, $f ends up looking like "3,3," instead.

Presumably, sometimes $l and the first delimiter get assigned to $f before
join() reads in $f. Usually, however, join() reads in $f before its result
get's assigned to $f.

This is my "optimize the assignment away" patch. I will think about
whether the 'T' specifier on "join" in opcode.pl is salvageable. If I
find no way to do it, off it goes (should be changed to 't'). It
would be a pity, since the savings should be pretty big...

Ilya

@p5pRT
Copy link
Author

p5pRT commented Aug 31, 1999

From [Unknown Contact. See original ticket]

James H . Cloos Jr . <cloos@​adamsmith.ai> writes​:

This is a bug report for perl from cloos@​jhcloos.com,
generated with the help of perlbug 1.27 running under perl 5.00561.

$f = join(',', $l, $f);

So, is it a bug in 5.005_6[01] or is just a assignment undefined behavior?

It is a bug. But as you say it does not occur with simple examples.
Can you try and prune back the real app so it fails?

--
Nick Ing-Simmons

@p5pRT
Copy link
Author

p5pRT commented Sep 1, 1999

From [Unknown Contact. See original ticket]

Ilya Zakharevich writes​:

This works in 5.005_03, but fails in certain complex scripts in 5.005_6[01]​:

after code of the form​:

my $f = "foo";
my $l = length($f);
$f = join(',', $l, $f);

$f usually -- and always in this simple example -- holds "3,foo".
Sometimes, however, $f ends up looking like "3,3," instead.

Presumably, sometimes $l and the first delimiter get assigned to $f before
join() reads in $f. Usually, however, join() reads in $f before its result
get's assigned to $f.

This is my "optimize the assignment away" patch. I will think about
whether the 'T' specifier on "join" in opcode.pl is salvageable. If I
find no way to do it, off it goes (should be changed to 't'). It
would be a pity, since the savings should be pretty big...

Enjoy the patch (tested with _58),
Ilya

Inline Patch
--- ./op.c~	Wed Aug 11 00:52:10 1999
+++ ./op.c	Tue Aug 31 21:35:30 1999
@@ -5161,6 +5161,19 @@ Perl_ck_sassign(pTHX_ OP *o)
 	    {
 		return o;
 	    }
+	    if (kid->op_type == OP_JOIN) {
+		/* do_join has problems if the arguments coincide with target.
+		   In fact the second argument *can* safely coincide with it,
+		   but we ignore=pessimize this rare occasion. */
+		OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */
+
+		while (arg) {
+		    if (arg->op_type == OP_PADSV
+			&& arg->op_targ == kkid->op_targ)
+			return o;
+		    arg = arg->op_sibling;
+		}
+	    }
 	    kid->op_targ = kkid->op_targ;
 	    /* Now we do not need PADSV and SASSIGN. */
 	    kid->op_sibling = o->op_sibling;	/* NULL */

@p5pRT
Copy link
Author

p5pRT commented Sep 1, 1999

From [Unknown Contact. See original ticket]

Ilya Zakharevich writes​:

Enjoy the patch (tested with _58),

Oups, forgot to include the test patch. Ignore the previous patch,
Ilya

Inline Patch
--- ./t/op/join.t~	Tue Jul 20 10:18:14 1999
+++ ./t/op/join.t	Tue Aug 31 21:40:50 1999
@@ -1,8 +1,6 @@
 #!./perl
 
-# $RCSfile: join.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:01 $
-
-print "1..3\n";
+print "1..6\n";
 
 @x = (1, 2, 3);
 if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
@@ -10,3 +8,15 @@ if (join(':',@x) eq '1:2:3') {print "ok 
 if (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";}
 
 if (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";}
+
+my $f = 'a';
+$f = join ',', 'b', $f, 'e';
+if ($f eq 'b,a,e') {print "ok 4\n";} else {print "# '$f'\nnot ok 4\n";}
+
+$f = 'a';
+$f = join ',', $f, 'b', 'e';
+if ($f eq 'a,b,e') {print "ok 5\n";} else {print "not ok 5\n";}
+
+$f = 'a';
+$f = join $f, 'b', 'e', 'k';
+if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";}
--- ./op.c~	Wed Aug 11 00:52:10 1999
+++ ./op.c	Tue Aug 31 21:35:30 1999
@@ -5161,6 +5161,19 @@ Perl_ck_sassign(pTHX_ OP *o)
 	    {
 		return o;
 	    }
+	    if (kid->op_type == OP_JOIN) {
+		/* do_join has problems the arguments coincide with target.
+		   In fact the second argument *can* safely coincide,
+		   but ignore=pessimize this rare occasion. */
+		OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */
+
+		while (arg) {
+		    if (arg->op_type == OP_PADSV
+			&& arg->op_targ == kkid->op_targ)
+			return o;
+		    arg = arg->op_sibling;
+		}
+	    }
 	    kid->op_targ = kkid->op_targ;
 	    /* Now we do not need PADSV and SASSIGN. */
 	    kid->op_sibling = o->op_sibling;	/* NULL */

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant