From @chipdude

Created by chip@pobox.com

The optimization for '@​a = sort @​a' is casting too wide a net​:

  use strict;
  use warnings;

  my @​list = qw(a g r t e r);
  @​list = ("foo", sort @​list);
  print "List​: @​list\n";

The "foo" is missing. Oops.

This bug still occurs in blead.

Flags:
    category=core
    severity=medium

Site configuration information for perl v5.8.4:

Configured by Debian Project at Wed May 12 00:32:16 EST 2004.

Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
  Platform:
    osname=linux, osvers=2.4.26-ti1211, archname=i386-linux-thread-multi
    uname='linux kosh 2.4.26-ti1211 #1 sat apr 24 14:46:58 est 2004 i686 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.4 -Dsitearch=/usr/local/lib/perl/5.8.4 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.4 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define 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='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='3.3.3 (Debian 20040429)', gccosandvers=''
    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, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.3.2.so, so=so, useshrplib=true, libperl=libperl.so.5.8.4
    gnulibc_version='2.3.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.4:
    /etc/perl
    /usr/local/lib/perl/5.8.4
    /usr/local/share/perl/5.8.4
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.8
    /usr/share/perl/5.8
    /usr/local/lib/site_perl
    /usr/local/lib/perl/5.8.3
    /usr/local/share/perl/5.8.3
    /usr/local/share/perl/5.8.2
    /usr/local/share/perl/5.8.1
    /usr/local/share/perl/5.8.0
    .


Environment for perl v5.8.4:
    HOME=/u/home/chip
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/u/home/chip/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games
    PERL_BADLANG (unset)
    SHELL=/bin/zsh

From @iabyn

On Fri, May 21, 2004 at 07​:45​:50PM -0000, Chip Salzenberg wrote​:

The optimization for '@​a = sort @​a' is casting too wide a net​:

use strict;
use warnings;

my @​list = qw\(a g r t e r\);
@​list = \("foo"\, sort @​list\);
print "List​: @​list\\n";

The "foo" is missing. Oops.

Oh the shame...

Fixed below.
Dave.

--
In my day, we used to edit the inodes by hand. With magnets.

Change 22839 by davem@​davem-percy on 2004/05/22 11​:15​:34

  [perl #29790] Optimization busted​: '@​a = "b", sort @​a' drops "b"
  Fix the sort-in-place optimization of change #22349.

Affected files ...

... //depot/perl/op.c#627 edit
... //depot/perl/t/op/sort.t#24 edit

Differences ...

==== //depot/perl/op.c#627 (text) ====

@​@​ -6642,6 +6642,17 @​@​
  || (o2->op_flags & OPf_WANT) != OPf_WANT_VOID)
  break;

+ /* check that the sort is the first arg on RHS of assign */
+
+ o2 = cUNOPx(o2)->op_first;
+ if (!o2 || o2->op_type != OP_NULL)
+ break;
+ o2 = cUNOPx(o2)->op_first;
+ if (!o2 || o2->op_type != OP_PUSHMARK)
+ break;
+ if (o2->op_sibling != o)
+ break;
+
  /* check the array is the same on both sides */
  if (oleft->op_type == OP_RV2AV) {
  if (oright->op_type != OP_RV2AV

==== //depot/perl/t/op/sort.t#24 (xtext) ====

@​@​ -5,7 +5,7 @​@​
  @​INC = '../lib';
}
use warnings;
-print "1..65\n";
+print "1..75\n";

# these shouldn't hang
{
@​@​ -354,13 +354,41 @​@​
  ok "$r1-@​a", "$r2-c b a", "inplace sort with function of lexical";

  use Tie​::Array;
- tie @​a, 'Tie​::StdArray';
+ my @​t;
+ tie @​t, 'Tie​::StdArray';
+
+ @​t = qw(b c a); @​t = sort @​t;
+ ok "@​t", "a b c", "inplace sort of tied array";
+
+ @​t = qw(b c a); @​t = sort mysort @​t;
+ ok "@​t", "c b a", "inplace sort of tied array with function";
+
+ # [perl #29790] don't optimise @​a = ('a', sort @​a) !
+
+ @​g = (3,2,1); @​g = ('0', sort @​g);
+ ok "@​g", "0 1 2 3", "un-inplace sort of global";
+ @​g = (3,2,1); @​g = (sort(@​g),'4');
+ ok "@​g", "1 2 3 4", "un-inplace sort of global 2";
+
+ @​a = qw(b a c); @​a = ('x', sort @​a);
+ ok "@​a", "x a b c", "un-inplace sort of lexical";
+ @​a = qw(b a c); @​a = ((sort @​a), 'x');
+ ok "@​a", "a b c x", "un-inplace sort of lexical 2";
+
+ @​g = (2,3,1); @​g = ('0', sort { $b <=> $a } @​g);
+ ok "@​g", "0 3 2 1", "un-inplace reversed sort of global";
+ @​g = (2,3,1); @​g = ((sort { $b <=> $a } @​g),'4');
+ ok "@​g", "3 2 1 4", "un-inplace reversed sort of global 2";

- @​a = qw(b c a); @​a = sort @​a;
- ok "@​a", "a b c", "inplace sort of tied array";
+ @​g = (2,3,1); @​g = ('0', sort { $a<$b?1​:$a>$b?-1​:0 } @​g);
+ ok "@​g", "0 3 2 1", "un-inplace custom sort of global";
+ @​g = (2,3,1); @​g = ((sort { $a<$b?1​:$a>$b?-1​:0 } @​g),'4');
+ ok "@​g", "3 2 1 4", "un-inplace custom sort of global 2";

- @​a = qw(b c a); @​a = sort mysort @​a;
- ok "@​a", "c b a", "inplace sort of tied array with function";
+ @​a = qw(b c a); @​a = ('x', sort mysort @​a);
+ ok "@​a", "x c b a", "un-inplace sort with function of lexical";
+ @​a = qw(b c a); @​a = ((sort mysort @​a),'x');
+ ok "@​a", "c b a x", "un-inplace sort with function of lexical 2";
}

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

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