sort(sub(args)) misparsed as sort sub args

[p5pRT]

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

Searchable as RT1549$

[p5pRT]

From sburke@netadventure.net

I found this bug (at least I consider it a bug) while trying to apply
sort to the output of a sub.
I tried​:
  sort(routine($arg))
and was surprised to find the output consisting of a one-element list,
consisting only of $arg!
Apparently this parses as a case of
  sort SUBNAME LIST

I can understand that as a correct reading for
  sort routine $arg
But not for
  sort(routine($arg))

I note that
  sort +(routine($arg))
does the Right Thing, as does
  sort( (), routine($arg))

***************************************************************************
LONG STORY (with example code, and perl -V output)

Note the output of this sample program​:

ttyp5 sburke ~ stonehenge 20​: perl
BEGIN{$^W = 1}
sub zoz { "one!", "two!", "three!" }; # ignores its @​_
print ">", join(" ", sort(zoz(5) ) ), "\n";
[I hit ctrl-d]
Unquoted string "zoz" may clash with future reserved word at - line 3.

5

Here's my version info​:
ttyp5 sburke ~ stonehenge 21​: perl -V
Summary of my perl5 (5.0 patchlevel 4 subversion 4) configuration​:
  Platform​:
  osname=bsdos, osvers=3.0, archname=i386-bsdos
  uname='bsdos stonehenge.netadventure.com 3.0 bsdi bsdos 3.0 kernel #0​: mon jul 28 00​:40​:29 pdt 1997 ken@​stonehenge.netadventure.com​:usrsrcsyscompilelocal i386 '
  hint=recommended, useposix=true, d_sigaction=define
  bincompat3=y useperlio=undef d_sfio=undef
  Compiler​:
  cc='shlicc2', optimize='-O2', gccversion=2.7.2.1
  cppflags='-I/usr/local/include'
  ccflags ='-I/usr/local/include'
  stdchar='char', d_stdstdio=undef, usevfork=false
  voidflags=15, castflags=0, d_casti32=define, d_castneg=define
  intsize=4, alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries​:
  ld='shlicc2', ldflags =' -L/usr/X11/lib -L/usr/local/lib'
  libpth=/usr/local/lib /usr/shlib /shlib /usr/lib /usr/X11/lib
  libs=-lrpc -lcurses -ltermcap -lXpm -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11 -ldl -lm -lc
  libc=/usr/lib/libc.a, so=o
  useshrplib=false, libperl=libperl.a
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=o, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags='-r -L/usr/X11/lib -L/usr/local/lib'

Characteristics of this binary (from libperl)​:
  Built under bsdos
  Compiled at Dec 31 1997 19​:45​:20
  @​INC​:
  /usr/local/lib/perl5/i386-bsdos/5.00404
  /usr/local/lib/perl5
  /usr/local/lib/perl5/site_perl/i386-bsdos
  /usr/local/lib/perl5/site_perl
  .

I get identical results on a box with this config info​:

lachler ~ musca​:pts/24 3​: perl -V
Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration​:
  Platform​:
  osname=aix, osvers=4.3.1.0, archname=aix
  uname='aix pegasus 3 4 000165185700 '
  hint=recommended, useposix=true, d_sigaction=define
  usethreads=undef useperlio=undef d_sfio=undef
  Compiler​:
  cc='cc', optimize='-O', gccversion=
  cppflags='-D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE -qmaxmem=8192 -I/usr/local/include -I/usr/local/gnu/include'
  ccflags ='-D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE -qmaxmem=8192 -I/usr/local/include -I/usr/local/gnu/include'
  stdchar='unsigned char', d_stdstdio=define, usevfork=false
  intsize=4, longsize=4, ptrsize=4, doublesize=8
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=8
  alignbytes=8, usemymalloc=n, prototype=define
  Linker and Libraries​:
  ld='ld', ldflags ='-L/usr/local/lib -L/usr/local/gnu/lib -L/usr/ccs/lib -L/lib'
  libpth=/usr/local/lib /lib /usr/lib /usr/ccs/lib /usr/local/gnu/lib
  libs=-lnsl -lgdbm -ldbm -ldl -lld -lm -lc -lcrypt -lbsd -lPW
  libc=, so=a, useshrplib=false, libperl=libperl.a
  Dynamic Linking​:
  dlsrc=dl_aix.xs, dlext=so, d_dlsymun=undef, ccdlflags='-bE​:perl.exp'
  cccdlflags=' ', lddlflags='-bhalt​:4 -bM​:SRE -bI​:$(PERL_INC)/perl.exp -bE​:$(BASEEXT).exp -b noentry -lc -L/usr/local/lib -L/usr/local/gnu/lib -L/usr/ccs/lib -L/lib'

Characteristics of this binary (from libperl)​:
  Built under aix
  Compiled at Aug 12 1999 09​:10​:29
  %ENV​:
  PERLLIB="/nfs/user/l/lachler/.bin/perl"
  @​INC​:
  /nfs/user/l/lachler/.bin/perl
  /usr/local/gnu/lib/perl5/5.00503/aix
  /usr/local/gnu/lib/perl5/5.00503
  /usr/local/gnu/lib/perl5/site_perl/5.005/aix
  /usr/local/gnu/lib/perl5/site_perl/5.005
  .

And even on MacPerl 5.2.0r4 (patchlevel 5.004) with the following -V​:
Summary of my ( patchlevel 0 subversion ) configuration​:
  Platform​:
  osname=MacOS, osvers=7.5, archname=
  uname=''
  hint=, useposix=true, d_sigaction=
  bincompat3= useperlio= d_sfio=
  Compiler​:
  cc='C', optimize='', gccversion=
  cppflags=''
  ccflags =''
  stdchar='', d_stdstdio=define, usevfork=
  voidflags=, castflags=0, d_casti32=32, d_castneg=define
  intsize=32, alignbytes=, usemymalloc=, randbits=
  Linker and Libraries​:
  ld='', ldflags =''
  libpth=
  libs=
  libc=, so=
  useshrplib=, libperl=
  Dynamic Linking​:
  dlsrc=, dlext=, d_dlsymun=, ccdlflags=''
  cccdlflags='', lddlflags=''

Characteristics of this binary (from libperl)​:
  Compile-time options​: MULTIPLICITY
  Built under MacOS
  Compiled at Apr 3 1998 21​:45​:13
  %ENV​:
  PERL5LIB="Slig​:MacPerl :site_perl,Slig​:MacPerl :lib,WebSites​:Sean,WebSites​:,Slig​:WIP Slig​:cgi-bin,Slig​:MacPerl :site_perl_dyna"
  @​INC​:
  Slig​:MacPerl :site_perl​:
  Slig​:MacPerl :lib​:MacPPC​:
  Slig​:MacPerl :lib​:
  WebSites​:Sean​:MacPPC​:
  WebSites​:Sean​:
  WebSites​:
  Slig​:WIP Slig​:cgi-bin​:
  Slig​:MacPerl :site_perl_dyna​:
  Slig​:MacPerl :lib​:MacPPC​:
  Slig​:MacPerl :lib​:
  Slig​:MacPerl :site_perl​:
  :
  Dev​:Pseudo​:

Here's an extended test program. Lines for B and C print '5'; all
others print "one! three! two!" (or for line A, "one! two! three!", of
course).

BEGIN{$^W = 1}
sub zoz { "one!", "two!", "three!" }; # ignores its @​_

print "A>", join(" ", zoz(5) ), "\n";
print "B>", join(" ", sort zoz(5) ), "\n";
  # parses as a case of sort SUBNAME LIST -- understandably.
  # generates no warning, of course.

print "C>", join(" ", sort(zoz(5) ) ), "\n";
# above line warns​: Unquoted string "zoz" may clash with future reserved word.
# is apparently parsed as a case of sort SUBNAME LIST
# instead of as a case of sort LIST

print "D>", join(" ", sort {$a cmp $b} zoz(5) ), "\n"; # works
print "E>", join(" ", sort +(zoz(5) ) ), "\n"; # WORKS!!!
print "F>", join(" ", sort( (), zoz(5) ) ), "\n"; # WORKS!
print "G>", join(" ", sort( &zoz(5) ) ), "\n"; # works
print "H>", join(" ", sort( &zoz ) ), "\n"; # works
print "\n";

--
Sean M. Burke sburke@​netadventure.net http​://www.netadventure.net/~sburke/

[p5pRT]

From [Unknown Contact. See original ticket]

Still true as of 8221.

-spp

SHORT STORY​:

I found this bug (at least I consider it a bug) while trying to apply
sort to the output of a sub.
I tried​:
  sort(routine($arg))
and was surprised to find the output consisting of a one-element list,
consisting only of $arg!
Apparently this parses as a case of
  sort SUBNAME LIST

I can understand that as a correct reading for
  sort routine $arg
But not for
  sort(routine($arg))

I note that
  sort +(routine($arg))
does the Right Thing, as does
  sort( (), routine($arg))

***************************************************************************
LONG STORY (with example code, and perl -V output)

Note the output of this sample program​:

ttyp5 sburke ~ stonehenge 20​: perl
BEGIN{$^W = 1}
sub zoz { "one!", "two!", "three!" }; # ignores its @​_
print ">", join(" ", sort(zoz(5) ) ), "\n";
[I hit ctrl-d]
Unquoted string "zoz" may clash with future reserved word at - line 3.

5

[p5pRT]

From @simoncozens

On Thu, Dec 21, 2000 at 03​:50​:14PM -0500, Stephen P. Potter wrote​:

Still true as of 8221.
I tried​:
sort(routine($arg))
and was surprised to find the output consisting of a one-element list,

It's a deliberate decision, although a slightly wacky one.
The crux is this bit in toke.c​:
  /* If not a declared subroutine, it's an indirect object. */ /* (But it's an indir obj regardless for sort.) */

  if ( ( PL_last_lop_op == OP_SORT ||
  (!immediate_paren && (!gv || !GvCVu(gv)))) &&
  (PL_last_lop_op != OP_MAPSTART &&
  PL_last_lop_op != OP_GREPSTART))
  {
  PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
  goto bareword;
  }

I think that first condition should change, but the fact that it's there and
commented makes me wary about patching it. It's also been there a long time,
since it doesn't show up on the repository browser's history thing. (ie patch <
4000)

Oh, well, this doesn't break anything​:

Inline Patch

--- toke.c~	Sun Dec 24 01:05:20 2000
+++ toke.c	Sun Dec 24 01:19:26 2000
@@ -3915,10 +3915,10 @@
 		    /* If not a declared subroutine, it's an indirect object. */
 		    /* (But it's an indir obj regardless for sort.) */
 
-		    if ((PL_last_lop_op == OP_SORT ||
-                         (!immediate_paren && (!gv || !GvCVu(gv)))) &&
+		    if ( (PL_last_lop_op == OP_SORT && !immediate_paren) || 
+                         ((!gv || !GvCVu(gv)) &&
                         (PL_last_lop_op != OP_MAPSTART &&
-			 PL_last_lop_op != OP_GREPSTART))
+			 PL_last_lop_op != OP_GREPSTART)))
 		    {
 			PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
 			goto bareword;
--- t/op/sort.t~	Sun Dec 24 01:20:45 2000
+++ t/op/sort.t	Sun Dec 24 01:22:19 2000
@@ -5,7 +5,7 @@
     @INC = '../lib';
 }
 use warnings;
-print "1..57\n";
+print "1..58\n";
 
 # XXX known to leak scalars
 {
@@ -320,4 +320,11 @@
     print ("@b" eq '1 2 3 4' ? "ok 56\n" : "not ok 56\n");
     print "# x = '@b'\n";
     print !$def ? "ok 57\n" : "not ok 57\n";
+}
+
+# Bug 19991001.003
+{
+    sub routine { "one", "two" };
+    @a = sort(routine(1));
+    print "@a" eq "one two" ? "ok 58\n" : "not ok 58\n";
 }

[p5pRT]

From @simoncozens

On Sun, Dec 24, 2000 at 01​:23​:01AM +0000, Simon Cozens wrote​:

Oh, well, this doesn't break anything​:

Yes it does. Let's try again. Man, that's some really tortuous logic in toke.c.

Inline Patch

--- t/op/method.t~	Wed Dec 27 14:03:40 2000
+++ t/op/method.t	Wed Dec 27 14:10:15 2000
@@ -9,7 +9,7 @@
     @INC = '../lib';
 }
 
-print "1..53\n";
+print "1..54\n";
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -185,3 +185,8 @@
 test(do { eval '$e = bless {}, "E"; $e->foo()';
 	  $@ =~ /^\QCan't locate object method "foo" via package "E" (perhaps / ? 1 : $@}, 1);
 
+# This is actually testing parsing of indirect objects and undefined subs
+#   print foo("bar") where foo does not exist is not an indirect object.
+#   print foo "bar"  where foo does not exist is an indirect object.
+eval { sub AUTOLOAD { "ok ", shift, "\n"; } };
+print nonsuch(++$cnt);
--- t/op/sort.t~	Sun Dec 24 01:20:45 2000
+++ t/op/sort.t	Sun Dec 24 01:22:19 2000
@@ -5,7 +5,7 @@
     @INC = '../lib';
 }
 use warnings;
-print "1..57\n";
+print "1..58\n";
 
 # XXX known to leak scalars
 {
@@ -320,4 +320,11 @@
     print ("@b" eq '1 2 3 4' ? "ok 56\n" : "not ok 56\n");
     print "# x = '@b'\n";
     print !$def ? "ok 57\n" : "not ok 57\n";
+}
+
+# Bug 19991001.003
+{
+    sub routine { "one", "two" };
+    @a = sort(routine(1));
+    print "@a" eq "one two" ? "ok 58\n" : "not ok 58\n";
 }
--- toke.c~	Sun Dec 24 01:05:20 2000
+++ toke.c	Wed Dec 27 14:00:46 2000
@@ -3915,10 +3915,10 @@
 		    /* If not a declared subroutine, it's an indirect object. */
 		    /* (But it's an indir obj regardless for sort.) */
 
-		    if ((PL_last_lop_op == OP_SORT ||
-                         (!immediate_paren && (!gv || !GvCVu(gv)))) &&
+		    if ( !immediate_paren && (PL_last_lop_op == OP_SORT || 
+                         ((!gv || !GvCVu(gv)) &&
                         (PL_last_lop_op != OP_MAPSTART &&
-			 PL_last_lop_op != OP_GREPSTART))
+			 PL_last_lop_op != OP_GREPSTART))))
 		    {
 			PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
 			goto bareword;