search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.85k stars 527 forks source link

Sort subroutine single nonsingle value #1670

Closed p5pRT closed 20 years ago

p5pRT commented 24 years ago

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

Searchable as RT2912$

p5pRT commented 24 years ago

From adelton@informatics.muni.cz

Created by adelton@fi.muni.cz

Please consider this simple script

  sub czcmp   { return 0; }   sub czsort   { sort { czcmp($a\, $b); } @​_; } ## this is line 4   my @​a = czsort(1\, 2);

The script fails with

  Sort subroutine didn't return single value at tst line 4.

which IMHO shouldn't -- I simply declare a block and call a function there\, but the sort somehow seems to catch that @​_. If I call it with just czsort(1)\, the error is not there.

Under 5.005_03 and previous\, this code (taken from Cz​::Sort module) works fine. It's simple to workaround it but I still think it is a bug\, since nor perldelta nor perlfunc seem to suggest that this use of sort is not allowed.

Yours\,

Honza Pazdziora adelton@​fi.muni.cz

Perl Info ``` Flags: category=core severity=medium Site configuration information for perl v5.6.0: Configured by adelton at Fri Mar 24 18:05:50 MET 2000. Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration: Platform: osname=solaris, osvers=2.7, archname=sun4-solaris uname='sunos theseus 5.7 generic sun4u sparc sunw,ultra-2 ' config_args='' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=undef d_sfio=undef uselargefiles=undef use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef Compiler: cc='gcc', optimize='-O3', gccversion=egcs-2.91.66 19990314 (egcs-1.1.2 release) cppflags='-fno-strict-aliasing' ccflags ='-fno-strict-aliasing' stdchar='char', d_stdstdio=define, usevfork=false intsize=4, longsize=4, ptrsize=4, doublesize=8 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4 alignbytes=8, usemymalloc=y, prototype=define Linker and Libraries: ld='gcc', ldflags ='' libpth=/lib /usr/lib /usr/ccs/lib libs=-lsocket -lnsl -ldl -lm -lc -lcrypt -lsec libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' ' cccdlflags='-fPIC', lddlflags='-G' Locally applied patches: @INC for perl v5.6.0: /export/packages/perl-5.6.0/lib/5.6.0/sun4-solaris /export/packages/perl-5.6.0/lib/5.6.0 /export/packages/perl-5.6.0/lib/site_perl/5.6.0/sun4-solaris /export/packages/perl-5.6.0/lib/site_perl/5.6.0 /export/packages/perl-5.6.0/lib/site_perl . Environment for perl v5.6.0: HOME=/home/adelton LANG (unset) LANGUAGE (unset) LC_CTYPE=cs LD_LIBRARY_PATH=/usr/lib:/usr/ucblib:/usr/openwin/lib:/packages/run/gcc-2.5.7/lib:/packages/run/links/lib LOGDIR (unset) PATH=/usr/bin:/usr/sbin:/usr/ccs/bin:/usr/openwin/bin:/packages/run/modules-2.0/bin:/export/packages/perl-5.6.0/bin:/packages/run/links/bin PERL_BADLANG (unset) SHELL=/bin/bash ```
p5pRT commented 24 years ago

From @gsar

On Fri\, 31 Mar 2000 13​:11​:28 +0200\, Jan Pazdziora wrote​:

This is a bug report for perl from adelton@​fi.muni.cz\, generated with the help of perlbug 1.28 running under perl v5.6.0. [...] Please consider this simple script

sub czcmp { return 0; } sub czsort { sort { czcmp($a\, $b); } @​_; } ## this is line 4 my @​a = czsort(1\, 2);

The script fails with

Sort subroutine didn't return single value at tst line 4.

which IMHO shouldn't -- I simply declare a block and call a function there\, but the sort somehow seems to catch that @​_. If I call it with just czsort(1)\, the error is not there.

Under 5.005_03 and previous\, this code (taken from Cz​::Sort module) works fine. It's simple to workaround it but I still think it is a bug\, since nor perldelta nor perlfunc seem to suggest that this use of sort is not allowed.

Please try this patch.

Sarathy gsar@​activestate.com

Inline Patch ```diff -----------------------------------8<----------------------------------- Change 5955 by gsar@auger on 2000/04/27 04:26:44 longstanding bug exposed by change#3307: sort arguments weren't compiled with the right wantarray context (ensuing runtime lookup via block_gimme() was getting the incidental context of the sort() itself) Affected files ... ... //depot/perl/op.c#286 edit ... //depot/perl/t/op/sort.t#18 edit Differences ... ==== //depot/perl/op.c#286 (text) ==== Index: perl/op.c --- perl/op.c.~1~ Wed Apr 26 21:28:47 2000 +++ perl/op.c Wed Apr 26 21:28:47 2000 @@ -5995,6 +5995,7 @@ OP * Perl_ck_sort(pTHX_ OP *o) { + OP *firstkid; o->op_private = 0; #ifdef USE_LOCALE if (PL_hints & HINT_LOCALE) @@ -6003,10 +6004,10 @@ if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED) simplify_sort(o); - if (o->op_flags & OPf_STACKED) { /* may have been cleared */ - OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ + firstkid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ + if (o->op_flags & OPf_STACKED) { /* may have been cleared */ OP *k; - kid = kUNOP->op_first; /* get past null */ + OP *kid = cUNOPx(firstkid)->op_first; /* get past null */ if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) { linklist(kid); @@ -6036,17 +6037,26 @@ } peep(k); - kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ - if (o->op_type == OP_SORT) + kid = firstkid; + if (o->op_type == OP_SORT) { + /* provide scalar context for comparison function/block */ + kid = scalar(kid); kid->op_next = kid; + } else kid->op_next = k; o->op_flags |= OPf_SPECIAL; } else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV) - null(cLISTOPo->op_first->op_sibling); + null(firstkid); + + firstkid = firstkid->op_sibling; } + /* provide list context for arguments */ + if (o->op_type == OP_SORT) + list(firstkid); + return o; } ==== //depot/perl/t/op/sort.t#18 (xtext) ==== Index: perl/t/op/sort.t --- perl/t/op/sort.t.~1~ Wed Apr 26 21:28:47 2000 +++ perl/t/op/sort.t Wed Apr 26 21:28:47 2000 @@ -5,7 +5,7 @@ unshift @INC, '../lib'; } use warnings; -print "1..49\n"; +print "1..55\n"; # XXX known to leak scalars { @@ -270,3 +270,36 @@ @b = sort main::Backwards_stacked @a; print ("@b" eq '90 5 255 1996 19' ? "ok 49\n" : "not ok 49\n"); print "# x = '@b'\n"; + +# check if context for sort arguments is handled right + +$test = 49; +sub test_if_list { + my $gimme = wantarray; + print "not " unless $gimme; + ++$test; + print "ok $test\n"; +} +my $m = sub { $a <=> $b }; + +sub cxt_one { sort $m test_if_list() } +cxt_one(); +sub cxt_two { sort { $a <=> $b } test_if_list() } +cxt_two(); +sub cxt_three { sort &test_if_list() } +cxt_three(); + +sub test_if_scalar { + my $gimme = wantarray; + print "not " if $gimme or !defined($gimme); + ++$test; + print "ok $test\n"; +} + +$m = \&test_if_scalar; +sub cxt_four { sort $m 1,2 } +@x = cxt_four(); +sub cxt_five { sort { test_if_scalar($a,$b); } 1,2 } +@x = cxt_five(); +sub cxt_six { sort test_if_scalar 1,2 } +@x = cxt_six(); End of Patch. ```