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

Segfault in debugger with tr// and UTF8 #9606

Closed
p5pRT opened this issue Dec 19, 2008 · 19 comments
Closed

Segfault in debugger with tr// and UTF8 #9606

p5pRT opened this issue Dec 19, 2008 · 19 comments

Comments

@p5pRT
Copy link

p5pRT commented Dec 19, 2008

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

Searchable as RT61520$

@p5pRT
Copy link
Author

p5pRT commented Dec 19, 2008

From @clintongormley

Created by @clintongormley

This is a bug report for perl from clint@​traveljury.com,
generated with the help of perlbug 1.36 running under perl 5.10.0.

-----------------------------------------------------------------
I have code which runs in Perl 5.10 without the debugger, but
segfaults with the debugger.

The offending line appears to be​:

  tr[aAbB\x{142}][]cd;

But only when it is invoked by string eval'ed code, or via
an anonymous sub.

I will upload a script which demonstrates the bug. Normally, under
the debugger, I get a segfault, However, in the last example (using
*symbol = sub { }), I get this error instead​:

  Assertion ((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV failed​: file
"hv.c", line 343

Also, I managed to trigger the following error​:

  panic​: swash_fetch got swatch of unexpected bit width

Unfortunately, I can't recreate the combination of code I had when that
error occurred, but it was thrown on the above-mention tr[] statement.

The attached code works fine under the debugger in 5.8.8 (32 bit)
The code itself was generated by the Sort​::ArbBiLex module

Perl Info

Flags:
    category=library
    severity=medium

This perlbug was built using Perl 5.10.0 - Tue Jul 15 14:37:49 UTC 2008
It is being executed now by  Perl 5.10.0 - Tue Jul 15 14:31:57 UTC 2008.

Site configuration information for perl 5.10.0:

Configured by abuild at Tue Jul 15 14:31:57 UTC 2008.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.25, archname=x86_64-linux-thread-multi
    uname='linux stravinsky 2.6.25 #1 smp 20080210 20:01:04 utc x86_64
x86_64 x86_64 gnulinux '
    config_args='-ds -e -Dprefix=/usr -Dvendorprefix=/usr
-Dinstallusrbinperl -Dusethreads -Di_db -Di_dbm -Di_ndbm -Di_gdbm
-Duseshrplib=true -Doptimize=-O2 -fmessage-length=0 -Wall
-D_FORTIFY_SOURCE=2 -fstack-protector -g -Wall -pipe
-Accflags=-DPERL_USE_SAFE_PUTENV'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV
-DDEBUGGING -fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE
-D_FILE_OFFSET_BITS=64',
    optimize='-O2 -fmessage-length=0 -Wall -D_FORTIFY_SOURCE=2
-fstack-protector -g -Wall -pipe',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV
-DDEBUGGING -fno-strict-aliasing -pipe'
    ccversion='', gccversion='4.3.1 20080507 (prerelease)
[gcc-4_3-branch revision 135036]', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib64'
    libpth=/lib64 /usr/lib64 /usr/local/lib64
    libs=-lm -ldl -lcrypt -lpthread
    perllibs=-lm -ldl -lcrypt -lpthread
    libc=/lib64/libc-2.8.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.8'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E
-Wl,-rpath,/usr/lib/perl5/5.10.0/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib64'

Locally applied patches:
    


@INC for perl 5.10.0:
    /usr/lib/perl5/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/5.10.0
    /usr/lib/perl5/site_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/site_perl/5.10.0
    /usr/lib/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.10.0
    /usr/lib/perl5/vendor_perl
    .


Environment for perl 5.10.0:
    HOME=/root
    LANG=en_GB.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)

PATH=/home/clinton/bin:/usr/local/bin:/usr/bin:/sbin:/usr/sbin:/bin:/usr/bin/X11:/usr/X11R6/bin:/usr/games:/opt/kde3/bin:/usr/lib64/jvm/jre/bin:/usr/lib/mit/bin:/usr/lib/mit/sbin
    PERL_BADLANG (unset)
    SHELL=/bin/bash


@p5pRT
Copy link
Author

p5pRT commented Dec 19, 2008

From @clintongormley

test.pl

@p5pRT
Copy link
Author

p5pRT commented Feb 25, 2009

From @iabyn

On Fri, Dec 19, 2008 at 05​:47​:50AM -0800, Clinton Gormley wrote​:

-----------------------------------------------------------------
I have code which runs in Perl 5.10 without the debugger, but
segfaults with the debugger.

The offending line appears to be​:

tr[aAbB\x{142}][]cd;

But only when it is invoked by string eval'ed code, or via
an anonymous sub.

I will upload a script which demonstrates the bug. Normally, under
the debugger, I get a segfault, However, in the last example (using
*symbol = sub { }), I get this error instead​:

Assertion ((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV failed​: file
"hv.c", line 343

I can confirm this bug is still present in bleed, but not in 5.8.8, 5.8.9

--
"But Sidley Park is already a picture, and a most amiable picture too.
The slopes are green and gentle. The trees are companionably grouped at
intervals that show them to advantage. The rill is a serpentine ribbon
unwound from the lake peaceably contained by meadows on which the right
amount of sheep are tastefully arranged." -- Lady Croom, "Arcadia"

@p5pRT
Copy link
Author

p5pRT commented Feb 25, 2009

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

@p5pRT
Copy link
Author

p5pRT commented Feb 25, 2009

From p5p@spam.wizbit.be

Assertion ((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV failed​:
file
"hv.c", line 343

I can confirm this bug is still present in bleed, but not in 5.8.8,
5.8.9

A binary search with -Dusethreads and -DDEBUGGING​: (-Dusethreads is
needed; not sure about -DDEBUGGING)

First change​: segfault

----Program----
#!/usr/bin/perl

$ENV{PERLDB_OPTS} = "NonStop";
system("$^X -d /tmp/rt-61520/test.pl");
exit $?;

----Output of .../poonaNK/perl-5.9.4@​29764/bin/perl----
cba
cba
cba
cba
cba

----EOF ($?='0')----
----Output of .../p0Ds90C/perl-5.9.4@​29765/bin/perl----

----EOF ($?='1536')----

http​://public.activestate.com/cgi-bin/perlbrowse/p/29765
Change 29765 by davem@​davem-pigeon on 2007/01/12 10​:42​:05

  make tr/// threadsafe by moving swash into pad

Second change​: failed assertion

----Program----
#!/usr/bin/perl

$ENV{PERLDB_OPTS} = "NonStop";
system("$^X -d /tmp/rt-61520/test.pl");
exit $?;

----Output of .../pDUJMDT/perl-5.9.5@​31921/bin/perl----

----EOF ($?='1536')----
----Output of .../pQZ8718/perl-5.9.5@​31922/bin/perl----
Assertion ((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV failed​: file
"hv.c", line 428 at /tmp/rt-61520/test.pl line 106.
at /tmp/rt-61520/test.pl line 106
  main​::__ANON__[/tmp/rt-61520/test.pl​:115]('a', 'b', 'c') called
at /tmp/rt-61520/test.pl line 163
cba
cba

----EOF ($?='0')----

http​://public.activestate.com/cgi-bin/perlbrowse/p/31922
Change 31922 by nicholas@​nicholas-fangorn on 2007/09/20 10​:20​:47

  assert that what is passed into the hash functions is really an
HV.
  (MRO code is calling hash functions during global destruction,
hence
  the check on SVTYPEMASK.)

Kind regards,

Bram

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @schwern

I've reduced this problem down to a lot less code which hopefully will
make it easier for someone to debug.

#!/usr/bin/perl

my $sub_ref = sub {
  return
  sort {
  $a =~ tr[\x{142}][];
  }
  "a", "b", "c"
};

# panic in the debugger
print( $sub_ref->(), "\n" );
__END__
panic​: swash_fetch got swatch of unexpected bit width at
/Users/schwern/tmp/61520.plx line 5.
at /Users/schwern/tmp/61520.plx line 5
  main​::__ANON__[/Users/schwern/tmp/61520.plx​:9]() called at
/Users/schwern/tmp/61520.plx line 14

If you put the map back in it segfaults.

#!/usr/bin/perl

my $sub_ref = sub {
  return
  sort {
  $a =~ tr[\x{142}][];
  }
  map { $_ } "a", "b", "c"
};

# segfault in the debugger
print( $sub_ref->(), "\n" );
__END__
Signal SEGV at /Users/schwern/tmp/61520.plx line 12
Abort trap (core dumped)

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @schwern

TODO tests for this can be had from git​://github.com/schwern/perl.git in
the rt.cpan.org-61520 branch. I've also attached them for convenience.

The clean up patch is not strictly necessary, but it wasn't clear what
package parts of the test file were in.

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @schwern

0002-TODO-tests-for-61520.patch
From e4aebee28b9f0c42dc886df170d40519efb16dfc Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Sat, 11 Jul 2009 00:39:46 -0700
Subject: [PATCH 2/2] TODO tests for 61520

---
 t/op/sort.t |   30 +++++++++++++++++++++++++++++-
 1 files changed, 29 insertions(+), 1 deletions(-)

diff --git a/t/op/sort.t b/t/op/sort.t
index cbb27a7..ce4fc36 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 144 );
+plan( tests => 146 );
 
 # these shouldn't hang
 {
@@ -801,3 +801,31 @@ ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
 sub ret_with_stacked { $_ = ($a<=>$b) + do {return $b <=> $a} }
 @b = sort ret_with_stacked 1..10;
 ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
+
+
+
+# rt.cpan.org 61520
+# tr/// with utf8 inside a sort in a sub ref or eval'd sub panics and/or segfaults.
+TODO: {
+    local $TODO = "rt.cpan.org 61520";
+
+    # Make the debugger just run
+    local $ENV{PERLDB_OPTS} = "NonStop";
+
+    # This causes a panic
+    fresh_perl_is(<<'CODE', "abc", { switches => ["-d"] }, "tr/// with utf8 inside sort in a sub ref");
+my $sub_ref = sub {
+    return sort { $a =~ tr[\x{142}][]; } qw(a b c);
+};
+print $sub_ref->();
+CODE
+
+    # With the map its a segfault
+    fresh_perl_is(<<'CODE', "abc", { switches => ["-d"] }, "tr/// with utf8 inside sort in a sub ref");
+my $sub_ref = sub {
+    return sort { $a =~ tr[\x{142}][]; } map { $_ } qw(a b c);
+};
+print $sub_ref->();
+CODE
+
+}
-- 
1.6.2.4

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @schwern

0001-Clean-up-t-op-sort.t-to-constrain-tests-which-use-a.patch
From f16e51bbb75c3ec4578fe2b4adae61935f32e5ee Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Sat, 11 Jul 2009 00:34:31 -0700
Subject: [PATCH 1/2] Clean up t/op/sort.t to constrain tests which use a particular package.
 Also make use of is() instead of a home rolled conflicting Test.pm style ok().

---
 t/op/sort.t |  313 +++++++++++++++++++++++++++++------------------------------
 1 files changed, 153 insertions(+), 160 deletions(-)

diff --git a/t/op/sort.t b/t/op/sort.t
index 4473c32..cbb27a7 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -2,7 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib); require 'test.pl';
+    @INC = qw(. ../lib);
+    require 'test.pl';
 }
 use warnings;
 plan( tests => 144 );
@@ -260,48 +261,43 @@ $x = join('', sort { $a <=> $b } 3, 1, 2);
 cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other arguments away with it));
 
 # test sorting in non-main package
-package Foo;
-@a = ( 5, 19, 1996, 255, 90 );
-@b = sort { $b <=> $a } @a;
-main::cmp_ok("@b",'eq','1996 255 90 19 5','not in main:: 1');
-
-
-@b = sort main::Backwards_stacked @a;
-main::cmp_ok("@b",'eq','90 5 255 1996 19','not in main:: 2');
-
-
-# check if context for sort arguments is handled right
-
-
-sub test_if_list {
-    my $gimme = wantarray;
-    main::is($gimme,1,'wantarray 1');
-
-
-}
-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();
+{
+    package Foo;
+    @a = ( 5, 19, 1996, 255, 90 );
+    @b = sort { $b <=> $a } @a;
+    ::cmp_ok("@b",'eq','1996 255 90 19 5','not in main:: 1');
 
-sub test_if_scalar {
-    my $gimme = wantarray;
-    main::is(!($gimme or !defined($gimme)),1,'wantarray 2');
+    @b = sort ::Backwards_stacked @a;
+    ::cmp_ok("@b",'eq','90 5 255 1996 19','not in main:: 2');
 
+    # check if context for sort arguments is handled right
+    sub test_if_list {
+        my $gimme = wantarray;
+        ::is($gimme,1,'wantarray 1');
+    }
+    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;
+        ::is(!($gimme or !defined($gimme)),1,'wantarray 2');
+    }
 
+    $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();
 }
 
-$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();
 
 # test against a reentrancy bug
 {
@@ -316,89 +312,81 @@ sub cxt_six { sort test_if_scalar 1,2 }
 	Bar::reenter() unless $init++;
 	$a <=> $b
     } qw/4 3 1 2/;
-    main::cmp_ok("@b",'eq','1 2 3 4','reenter 1');
+    cmp_ok("@b",'eq','1 2 3 4','reenter 1');
 
-    main::ok(!$def,'reenter 2');
+    ok(!$def,'reenter 2');
 }
 
 
 {
     sub routine { "one", "two" };
     @a = sort(routine(1));
-    main::cmp_ok("@a",'eq',"one two",'bug id 19991001.003');
+    cmp_ok("@a",'eq',"one two",'bug id 19991001.003');
 }
 
 
-#my $test = 59;
-sub ok { main::cmp_ok($_[0],'eq',$_[1],$_[2]);
-#    print "not " unless $_[0] eq $_[1];
-#    print "ok $test - $_[2]\n";
-#    print "#[$_[0]] ne [$_[1]]\n" unless $_[0] eq $_[1];
-#    $test++;
-}
-
 # check for in-place optimisation of @a = sort @a
 {
     my ($r1,$r2,@a);
     our @g;
     @g = (3,2,1); $r1 = \$g[2]; @g = sort @g; $r2 = \$g[0];
-    ok "$r1-@g", "$r2-1 2 3", "inplace sort of global";
+    is "$r1-@g", "$r2-1 2 3", "inplace sort of global";
 
     @a = qw(b a c); $r1 = \$a[1]; @a = sort @a; $r2 = \$a[0];
-    ok "$r1-@a", "$r2-a b c", "inplace sort of lexical";
+    is "$r1-@a", "$r2-a b c", "inplace sort of lexical";
 
     @g = (2,3,1); $r1 = \$g[1]; @g = sort { $b <=> $a } @g; $r2 = \$g[0];
-    ok "$r1-@g", "$r2-3 2 1", "inplace reversed sort of global";
+    is "$r1-@g", "$r2-3 2 1", "inplace reversed sort of global";
 
     @g = (2,3,1);
     $r1 = \$g[1]; @g = sort { $a<$b?1:$a>$b?-1:0 } @g; $r2 = \$g[0];
-    ok "$r1-@g", "$r2-3 2 1", "inplace custom sort of global";
+    is "$r1-@g", "$r2-3 2 1", "inplace custom sort of global";
 
     sub mysort { $b cmp $a };
     @a = qw(b c a); $r1 = \$a[1]; @a = sort mysort @a; $r2 = \$a[0];
-    ok "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
+    is "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
 
     use Tie::Array;
     my @t;
     tie @t, 'Tie::StdArray';
 
     @t = qw(b c a); @t = sort @t;
-    ok "@t", "a b c", "inplace sort of tied array";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@g", "3 2 1 4", "un-inplace reversed sort of global 2";
 
     @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";
+    is "@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";
+    is "@g", "3 2 1 4", "un-inplace custom sort of global 2";
 
     @a = qw(b c a); @a = ('x', sort mysort @a);
-    ok "@a", "x c b a", "un-inplace sort with function of lexical";
+    is "@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";
+    is "@a", "c b a x", "un-inplace sort with function of lexical 2";
 
     # RT#54758. Git 62b40d2474e7487e6909e1872b6bccdf812c6818
     no warnings 'void';
     my @m; push @m, 0 for 1 .. 1024; $#m; @m = sort @m;
-    main::pass("in-place sorting segfault");
+    ::pass("in-place sorting segfault");
 }
 
 # Test optimisations of reversed sorts. As we now guarantee stability by
@@ -424,77 +412,77 @@ sub generate {
 
 my @input = &generate;
 my @output = sort @input;
-ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort";
+is join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort";
 
 @input = &generate;
 @input = sort @input;
-ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
+is join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
     "Simple stable in place sort";
 
 # This won't be very interesting
 @input = &generate;
 @output = sort {$a <=> $b} @input;
-ok "@output", "A A A B B B C C C", 'stable $a <=> $b sort';
+is "@output", "A A A B B B C C C", 'stable $a <=> $b sort';
 
 @input = &generate;
 @output = sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort';
+is join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort';
 
 @input = &generate;
 @input = sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
+is join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
     'stable $a cmp $b in place sort';
 
 @input = &generate;
 @output = sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort';
+is join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort';
 
 @input = &generate;
 @input = sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2",
+is join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2",
     'stable $b cmp $a in place sort';
 
 @input = &generate;
 @output = reverse sort @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort";
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort";
 
 @input = &generate;
 @input = reverse sort @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     "Reversed stable in place sort";
 
 @input = &generate;
 my $output = reverse sort @input;
-ok $output, "CCCBBBAAA", "Reversed stable sort in scalar context";
+is $output, "CCCBBBAAA", "Reversed stable sort in scalar context";
 
 
 @input = &generate;
 @output = reverse sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable $a cmp $b sort';
 
 @input = &generate;
 @input = reverse sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     'revesed stable $a cmp $b in place sort';
 
 @input = &generate;
 $output = reverse sort {$a cmp $b} @input;
-ok $output, "CCCBBBAAA", 'Reversed stable $a cmp $b sort in scalar context';
+is $output, "CCCBBBAAA", 'Reversed stable $a cmp $b sort in scalar context';
 
 @input = &generate;
 @output = reverse sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
     'reversed stable $b cmp $a sort';
 
 @input = &generate;
 @input = reverse sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6",
     'revesed stable $b cmp $a in place sort';
 
 @input = &generate;
 $output = reverse sort {$b cmp $a} @input;
-ok $output, "AAABBBCCC", 'Reversed stable $b cmp $a sort in scalar context';
+is $output, "AAABBBCCC", 'Reversed stable $b cmp $a sort in scalar context';
 
 sub stuff {
     # Something complex enough to defeat any constant folding optimiser
@@ -503,27 +491,27 @@ sub stuff {
 
 @input = &generate;
 @output = reverse sort {stuff || $a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable complex sort';
 
 @input = &generate;
 @input = reverse sort {stuff || $a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     'revesed stable complex in place sort';
 
 @input = &generate;
 $output = reverse sort {stuff || $a cmp $b } @input;
-ok $output, "CCCBBBAAA", 'Reversed stable complex sort in scalar context';
+is $output, "CCCBBBAAA", 'Reversed stable complex sort in scalar context';
 
 sub sortr {
     reverse sort @_;
 }
 
 @output = sortr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable sort return list context';
 $output = sortr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable sort return scalar context';
 
 sub sortcmpr {
@@ -531,10 +519,10 @@ sub sortcmpr {
 }
 
 @output = sortcmpr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable $a cmp $b sort return list context';
 $output = sortcmpr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable $a cmp $b sort return scalar context';
 
 sub sortcmprba {
@@ -542,10 +530,10 @@ sub sortcmprba {
 }
 
 @output = sortcmprba &generate;
-ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
     'reversed stable $b cmp $a sort return list context';
 $output = sortcmprba &generate;
-ok $output, "AAABBBCCC",
+is $output, "AAABBBCCC",
 'reversed stable $b cmp $a sort return scalar context';
 
 sub sortcmprq {
@@ -553,10 +541,10 @@ sub sortcmprq {
 }
 
 @output = sortcmpr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable complex sort return list context';
 $output = sortcmpr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable complex sort return scalar context';
 
 # And now with numbers
@@ -569,148 +557,148 @@ sub generate1 {
 # This won't be very interesting
 @input = &generate1;
 @output = sort {$a cmp $b} @input;
-ok "@output", "A B C D E F G H I", 'stable $a cmp $b sort';
+is "@output", "A B C D E F G H I", 'stable $a cmp $b sort';
 
 @input = &generate1;
 @output = sort {$a <=> $b} @input;
-ok "@output", "A B C D E F G H I", 'stable $a <=> $b sort';
+is "@output", "A B C D E F G H I", 'stable $a <=> $b sort';
 
 @input = &generate1;
 @input = sort {$a <=> $b} @input;
-ok "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort';
+is "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort';
 
 @input = &generate1;
 @output = sort {$b <=> $a} @input;
-ok "@output", "G H I D E F A B C", 'stable $b <=> $a sort';
+is "@output", "G H I D E F A B C", 'stable $b <=> $a sort';
 
 @input = &generate1;
 @input = sort {$b <=> $a} @input;
-ok "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort';
+is "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort';
 
 # test that optimized {$b cmp $a} and {$b <=> $a} remain stable
 # (new in 5.9) without overloading
 { no warnings;
 @b = sort { $b <=> $a } @input = qw/5first 6first 5second 6second/;
-ok "@b" , "6first 6second 5first 5second", "optimized {$b <=> $a} without overloading" ;
+is "@b" , "6first 6second 5first 5second", "optimized {$b <=> $a} without overloading" ;
 @input = sort {$b <=> $a} @input;
-ok "@input" , "6first 6second 5first 5second","inline optimized {$b <=> $a} without overloading" ;
+is "@input" , "6first 6second 5first 5second","inline optimized {$b <=> $a} without overloading" ;
 };
 
 # These two are actually doing string cmp on 0 1 and 2
 @input = &generate1;
 @output = reverse sort @input;
-ok "@output", "I H G F E D C B A", "Reversed stable sort";
+is "@output", "I H G F E D C B A", "Reversed stable sort";
 
 @input = &generate1;
 @input = reverse sort @input;
-ok "@input", "I H G F E D C B A", "Reversed stable in place sort";
+is "@input", "I H G F E D C B A", "Reversed stable in place sort";
 
 @input = &generate1;
 $output = reverse sort @input;
-ok $output, "IHGFEDCBA", "Reversed stable sort in scalar context";
+is $output, "IHGFEDCBA", "Reversed stable sort in scalar context";
 
 @input = &generate1;
 @output = reverse sort {$a <=> $b} @input;
-ok "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort';
+is "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort';
 
 @input = &generate1;
 @input = reverse sort {$a <=> $b} @input;
-ok "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort';
+is "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort';
 
 @input = &generate1;
 $output = reverse sort {$a <=> $b} @input;
-ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort in scalar context';
+is $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort in scalar context';
 
 @input = &generate1;
 @output = reverse sort {$b <=> $a} @input;
-ok "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort';
+is "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort';
 
 @input = &generate1;
 @input = reverse sort {$b <=> $a} @input;
-ok "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort';
+is "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort';
 
 @input = &generate1;
 $output = reverse sort {$b <=> $a} @input;
-ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort in scalar context';
+is $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort in scalar context';
 
 @input = &generate1;
 @output = reverse sort {stuff || $a <=> $b} @input;
-ok "@output", "I H G F E D C B A", 'reversed stable complex sort';
+is "@output", "I H G F E D C B A", 'reversed stable complex sort';
 
 @input = &generate1;
 @input = reverse sort {stuff || $a <=> $b} @input;
-ok "@input", "I H G F E D C B A", 'revesed stable complex in place sort';
+is "@input", "I H G F E D C B A", 'revesed stable complex in place sort';
 
 @input = &generate1;
 $output = reverse sort {stuff || $a <=> $b} @input;
-ok $output, "IHGFEDCBA", 'reversed stable complex sort in scalar context';
+is $output, "IHGFEDCBA", 'reversed stable complex sort in scalar context';
 
 sub sortnumr {
     reverse sort {$a <=> $b} @_;
 }
 
 @output = sortnumr &generate1;
-ok "@output", "I H G F E D C B A",
+is "@output", "I H G F E D C B A",
     'reversed stable $a <=> $b sort return list context';
 $output = sortnumr &generate1;
-ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort return scalar context';
+is $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort return scalar context';
 
 sub sortnumrba {
     reverse sort {$b <=> $a} @_;
 }
 
 @output = sortnumrba &generate1;
-ok "@output", "C B A F E D I H G",
+is "@output", "C B A F E D I H G",
     'reversed stable $b <=> $a sort return list context';
 $output = sortnumrba &generate1;
-ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort return scalar context';
+is $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort return scalar context';
 
 sub sortnumrq {
     reverse sort {stuff || $a <=> $b} @_;
 }
 
 @output = sortnumrq &generate1;
-ok "@output", "I H G F E D C B A",
+is "@output", "I H G F E D C B A",
     'reversed stable complex sort return list context';
 $output = sortnumrq &generate1;
-ok $output, "IHGFEDCBA", 'reversed stable complex sort return scalar context';
+is $output, "IHGFEDCBA", 'reversed stable complex sort return scalar context';
 
 @output = reverse (sort(qw(C A B)), 0);
-ok "@output", "0 C B A", 'reversed sort with trailing argument';
+is "@output", "0 C B A", 'reversed sort with trailing argument';
 
 @output = reverse (0, sort(qw(C A B)));
-ok "@output", "C B A 0", 'reversed sort with leading argument';
+is "@output", "C B A 0", 'reversed sort with leading argument';
 
 eval { @output = sort {goto sub {}} 1,2; };
 $fail_msg = q(Can't goto subroutine outside a subroutine);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr outside subr');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr outside subr');
 
 
 
 sub goto_sub {goto sub{}}
 eval { @output = sort goto_sub 1,2; };
 $fail_msg = q(Can't goto subroutine from a sort sub);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr from a sort sub');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr from a sort sub');
 
 
 
 eval { @output = sort {goto label} 1,2; };
 $fail_msg = q(Can't "goto" out of a pseudo block);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 1');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 1');
 
 
 
 sub goto_label {goto label}
 label: eval { @output = sort goto_label 1,2; };
 $fail_msg = q(Can't "goto" out of a pseudo block);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 2');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 2');
 
 
 
 sub self_immolate {undef &self_immolate; $a<=>$b}
 eval { @output = sort self_immolate 1,2,3 };
 $fail_msg = q(Can't undef active subroutine);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
 
 
 
@@ -729,13 +717,12 @@ main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
     }
 
     rec(1);
-    main::ok(!$failed, "sort from active sub");
+    ok(!$failed, "sort from active sub");
 }
 
 # $a and $b are set in the package the sort() is called from,
 # *not* the package the sort sub is in. This is longstanding
 # de facto behaviour that shouldn't be broken.
-package main;
 my $answer = "good";
 () = sort OtherPack::foo 1,2,3,4;
 
@@ -749,50 +736,56 @@ my $answer = "good";
     }
 }
 
-main::cmp_ok($answer,'eq','good','sort subr called from other package');
+cmp_ok($answer,'eq','good','sort subr called from other package');
 
 
 # Bug 36430 - sort called in package2 while a
 # sort in package1 is active should set $package2::a/b.
-
-$answer = "good";
-my @list = sort { A::min(@$a) <=> A::min(@$b) }
-  [3, 1, 5], [2, 4], [0];
-
-main::cmp_ok($answer,'eq','good','bug 36430');
-
-package A;
-sub min {
-  my @list = sort {
-    $answer = '$a and/or $b are not defined ' if !defined($a) || !defined($b);
-    $a <=> $b;
-  } @_;
-  $list[0];
+{
+    my $answer = "good";
+    my @list = sort { A::min(@$a) <=> A::min(@$b) }
+      [3, 1, 5], [2, 4], [0];
+
+    cmp_ok($answer,'eq','good','bug 36430');
+
+    package A;
+    sub min {
+        my @list = sort {
+            $answer = '$a and/or $b are not defined ' if !defined($a) || !defined($b);
+            $a <=> $b;
+        } @_;
+        $list[0];
+    }
 }
 
+
 # Bug 7567 - an array shouldn't be modifiable while it's being
 # sorted in-place.
-eval { @a=(1..8); @a = sort { @a = (0) } @a; };
-
-$fail_msg = q(Modification of a read-only value attempted);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
+{
+    eval { @a=(1..8); @a = sort { @a = (0) } @a; };
 
+    $fail_msg = q(Modification of a read-only value attempted);
+    cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
+}
 
 
 # Sorting shouldn't increase the refcount of a sub
-sub foo {(1+$a) <=> (1+$b)}
-my $refcnt = &Internals::SvREFCNT(\&foo);
-@output = sort foo 3,7,9;
-package Foo;
-ok($refcnt, &Internals::SvREFCNT(\&foo), "sort sub refcnt");
-$fail_msg = q(Modification of a read-only value attempted);
-# Sorting a read-only array in-place shouldn't be allowed
-my @readonly = (1..10);
-Internals::SvREADONLY(@readonly, 1);
-eval { @readonly = sort @readonly; };
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'in-place sort of read-only array');
-
-
+{
+    sub foo {(1+$a) <=> (1+$b)}
+    my $refcnt = &Internals::SvREFCNT(\&foo);
+    @output = sort foo 3,7,9;
+
+    {
+        package Foo;
+        ::is($refcnt, &Internals::SvREFCNT(\&foo), "sort sub refcnt");
+        $fail_msg = q(Modification of a read-only value attempted);
+        # Sorting a read-only array in-place shouldn't be allowed
+        my @readonly = (1..10);
+        Internals::SvREADONLY(@readonly, 1);
+        eval { @readonly = sort @readonly; };
+        ::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'in-place sort of read-only array');
+    }
+}
 
 
 # Using return() should be okay even in a deeper context
-- 
1.6.2.4

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @iabyn

On Sat, Jul 11, 2009 at 12​:43​:11AM -0700, Michael G Schwern via RT wrote​:

TODO tests for this can be had from git​://github.com/schwern/perl.git in
the rt.cpan.org-61520 branch. I've also attached them for convenience.

Thanks for this. However, I've now fixed the bug (spurred on by the
simplified test case) and it turns out it was unrelated to either sort or
debugging, so I've not applied your tests and instead added a simpler test
to a different file, t/op/tr.t, via commit
a5446a6.

The bug affected any utf-8 tr// used within an anonymous sub that gets
cloned at run-time. Cloning of an anon sub occurs
  * if its a closure (refers to an outer lexical var), or
  * contains an eval (or //ee, etc), or
  * the debugger is enabled.
The last of the three is how the bug showed up in the original test case.

The clean up patch is not strictly necessary, but it wasn't clear what
package parts of the test file were in.

I tried applying that, but it appears to give spurious output when run
under t/TEST or t/harness​:

  # return with SVs on stack
  # return with SVs on stack

so I've left it for someone else to (hopefully) sort out.

--
Art is anything that has a label (especially if the label is "untitled 1")

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @schwern

Dave Mitchell wrote​:

On Sat, Jul 11, 2009 at 12​:43​:11AM -0700, Michael G Schwern via RT wrote​:

TODO tests for this can be had from git​://github.com/schwern/perl.git in
the rt.cpan.org-61520 branch. I've also attached them for convenience.

Thanks for this. However, I've now fixed the bug (spurred on by the
simplified test case) and it turns out it was unrelated to either sort or
debugging, so I've not applied your tests and instead added a simpler test
to a different file, t/op/tr.t, via commit
a5446a6.

Woo!

The clean up patch is not strictly necessary, but it wasn't clear what
package parts of the test file were in.

I tried applying that, but it appears to give spurious output when run
under t/TEST or t/harness​:

\# return with SVs on stack
\# return with SVs on stack

so I've left it for someone else to (hopefully) sort out.

I'll have a look.

--
Look at me talking when there's science to do.
When I look out there it makes me glad I'm not you.
I've experiments to be run.
There is research to be done
On the people who are still alive.
  -- Jonathan Coulton, "Still Alive"

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @schwern

Michael G Schwern wrote​:

Dave Mitchell wrote​:

The clean up patch is not strictly necessary, but it wasn't clear what
package parts of the test file were in.
I tried applying that, but it appears to give spurious output when run
under t/TEST or t/harness​:

\# return with SVs on stack
\# return with SVs on stack

so I've left it for someone else to (hopefully) sort out.

I'll have a look.

Ok, fixed. The old code had a home rolled Test.pm style ok() that I got rid
of and forgot to change them to is().

Fixed in the branch (force a pull) and also attached.

--
Don't try the paranormal until you know what's normal.
  -- "Lords and Ladies" by Terry Prachett

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2009

From @schwern

0001-Clean-up-t-op-sort.t-to-constrain-tests-which-use-a.patch
From cddbb0bf24f54a63f1db426b2f0636051a1c43ae Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Sat, 11 Jul 2009 00:34:31 -0700
Subject: [PATCH] Clean up t/op/sort.t to constrain tests which use a particular package.
 Also make use of is() instead of a home rolled conflicting Test.pm style ok().

---
 t/op/sort.t |  319 +++++++++++++++++++++++++++++------------------------------
 1 files changed, 156 insertions(+), 163 deletions(-)

diff --git a/t/op/sort.t b/t/op/sort.t
index 4473c32..616761a 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -2,7 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib); require 'test.pl';
+    @INC = qw(. ../lib);
+    require 'test.pl';
 }
 use warnings;
 plan( tests => 144 );
@@ -260,48 +261,43 @@ $x = join('', sort { $a <=> $b } 3, 1, 2);
 cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other arguments away with it));
 
 # test sorting in non-main package
-package Foo;
-@a = ( 5, 19, 1996, 255, 90 );
-@b = sort { $b <=> $a } @a;
-main::cmp_ok("@b",'eq','1996 255 90 19 5','not in main:: 1');
-
-
-@b = sort main::Backwards_stacked @a;
-main::cmp_ok("@b",'eq','90 5 255 1996 19','not in main:: 2');
-
-
-# check if context for sort arguments is handled right
-
-
-sub test_if_list {
-    my $gimme = wantarray;
-    main::is($gimme,1,'wantarray 1');
-
-
-}
-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();
+{
+    package Foo;
+    @a = ( 5, 19, 1996, 255, 90 );
+    @b = sort { $b <=> $a } @a;
+    ::cmp_ok("@b",'eq','1996 255 90 19 5','not in main:: 1');
 
-sub test_if_scalar {
-    my $gimme = wantarray;
-    main::is(!($gimme or !defined($gimme)),1,'wantarray 2');
+    @b = sort ::Backwards_stacked @a;
+    ::cmp_ok("@b",'eq','90 5 255 1996 19','not in main:: 2');
 
+    # check if context for sort arguments is handled right
+    sub test_if_list {
+        my $gimme = wantarray;
+        ::is($gimme,1,'wantarray 1');
+    }
+    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;
+        ::is(!($gimme or !defined($gimme)),1,'wantarray 2');
+    }
 
+    $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();
 }
 
-$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();
 
 # test against a reentrancy bug
 {
@@ -316,89 +312,81 @@ sub cxt_six { sort test_if_scalar 1,2 }
 	Bar::reenter() unless $init++;
 	$a <=> $b
     } qw/4 3 1 2/;
-    main::cmp_ok("@b",'eq','1 2 3 4','reenter 1');
+    cmp_ok("@b",'eq','1 2 3 4','reenter 1');
 
-    main::ok(!$def,'reenter 2');
+    ok(!$def,'reenter 2');
 }
 
 
 {
     sub routine { "one", "two" };
     @a = sort(routine(1));
-    main::cmp_ok("@a",'eq',"one two",'bug id 19991001.003');
+    cmp_ok("@a",'eq',"one two",'bug id 19991001.003');
 }
 
 
-#my $test = 59;
-sub ok { main::cmp_ok($_[0],'eq',$_[1],$_[2]);
-#    print "not " unless $_[0] eq $_[1];
-#    print "ok $test - $_[2]\n";
-#    print "#[$_[0]] ne [$_[1]]\n" unless $_[0] eq $_[1];
-#    $test++;
-}
-
 # check for in-place optimisation of @a = sort @a
 {
     my ($r1,$r2,@a);
     our @g;
     @g = (3,2,1); $r1 = \$g[2]; @g = sort @g; $r2 = \$g[0];
-    ok "$r1-@g", "$r2-1 2 3", "inplace sort of global";
+    is "$r1-@g", "$r2-1 2 3", "inplace sort of global";
 
     @a = qw(b a c); $r1 = \$a[1]; @a = sort @a; $r2 = \$a[0];
-    ok "$r1-@a", "$r2-a b c", "inplace sort of lexical";
+    is "$r1-@a", "$r2-a b c", "inplace sort of lexical";
 
     @g = (2,3,1); $r1 = \$g[1]; @g = sort { $b <=> $a } @g; $r2 = \$g[0];
-    ok "$r1-@g", "$r2-3 2 1", "inplace reversed sort of global";
+    is "$r1-@g", "$r2-3 2 1", "inplace reversed sort of global";
 
     @g = (2,3,1);
     $r1 = \$g[1]; @g = sort { $a<$b?1:$a>$b?-1:0 } @g; $r2 = \$g[0];
-    ok "$r1-@g", "$r2-3 2 1", "inplace custom sort of global";
+    is "$r1-@g", "$r2-3 2 1", "inplace custom sort of global";
 
     sub mysort { $b cmp $a };
     @a = qw(b c a); $r1 = \$a[1]; @a = sort mysort @a; $r2 = \$a[0];
-    ok "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
+    is "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
 
     use Tie::Array;
     my @t;
     tie @t, 'Tie::StdArray';
 
     @t = qw(b c a); @t = sort @t;
-    ok "@t", "a b c", "inplace sort of tied array";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@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";
+    is "@g", "3 2 1 4", "un-inplace reversed sort of global 2";
 
     @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";
+    is "@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";
+    is "@g", "3 2 1 4", "un-inplace custom sort of global 2";
 
     @a = qw(b c a); @a = ('x', sort mysort @a);
-    ok "@a", "x c b a", "un-inplace sort with function of lexical";
+    is "@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";
+    is "@a", "c b a x", "un-inplace sort with function of lexical 2";
 
     # RT#54758. Git 62b40d2474e7487e6909e1872b6bccdf812c6818
     no warnings 'void';
     my @m; push @m, 0 for 1 .. 1024; $#m; @m = sort @m;
-    main::pass("in-place sorting segfault");
+    ::pass("in-place sorting segfault");
 }
 
 # Test optimisations of reversed sorts. As we now guarantee stability by
@@ -424,77 +412,77 @@ sub generate {
 
 my @input = &generate;
 my @output = sort @input;
-ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort";
+is join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort";
 
 @input = &generate;
 @input = sort @input;
-ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
+is join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
     "Simple stable in place sort";
 
 # This won't be very interesting
 @input = &generate;
 @output = sort {$a <=> $b} @input;
-ok "@output", "A A A B B B C C C", 'stable $a <=> $b sort';
+is "@output", "A A A B B B C C C", 'stable $a <=> $b sort';
 
 @input = &generate;
 @output = sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort';
+is join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort';
 
 @input = &generate;
 @input = sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
+is join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8",
     'stable $a cmp $b in place sort';
 
 @input = &generate;
 @output = sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort';
+is join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort';
 
 @input = &generate;
 @input = sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2",
+is join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2",
     'stable $b cmp $a in place sort';
 
 @input = &generate;
 @output = reverse sort @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort";
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort";
 
 @input = &generate;
 @input = reverse sort @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     "Reversed stable in place sort";
 
 @input = &generate;
 my $output = reverse sort @input;
-ok $output, "CCCBBBAAA", "Reversed stable sort in scalar context";
+is $output, "CCCBBBAAA", "Reversed stable sort in scalar context";
 
 
 @input = &generate;
 @output = reverse sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable $a cmp $b sort';
 
 @input = &generate;
 @input = reverse sort {$a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     'revesed stable $a cmp $b in place sort';
 
 @input = &generate;
 $output = reverse sort {$a cmp $b} @input;
-ok $output, "CCCBBBAAA", 'Reversed stable $a cmp $b sort in scalar context';
+is $output, "CCCBBBAAA", 'Reversed stable $a cmp $b sort in scalar context';
 
 @input = &generate;
 @output = reverse sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
     'reversed stable $b cmp $a sort';
 
 @input = &generate;
 @input = reverse sort {$b cmp $a} @input;
-ok join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6",
     'revesed stable $b cmp $a in place sort';
 
 @input = &generate;
 $output = reverse sort {$b cmp $a} @input;
-ok $output, "AAABBBCCC", 'Reversed stable $b cmp $a sort in scalar context';
+is $output, "AAABBBCCC", 'Reversed stable $b cmp $a sort in scalar context';
 
 sub stuff {
     # Something complex enough to defeat any constant folding optimiser
@@ -503,27 +491,27 @@ sub stuff {
 
 @input = &generate;
 @output = reverse sort {stuff || $a cmp $b} @input;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable complex sort';
 
 @input = &generate;
 @input = reverse sort {stuff || $a cmp $b} @input;
-ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0",
     'revesed stable complex in place sort';
 
 @input = &generate;
 $output = reverse sort {stuff || $a cmp $b } @input;
-ok $output, "CCCBBBAAA", 'Reversed stable complex sort in scalar context';
+is $output, "CCCBBBAAA", 'Reversed stable complex sort in scalar context';
 
 sub sortr {
     reverse sort @_;
 }
 
 @output = sortr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable sort return list context';
 $output = sortr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable sort return scalar context';
 
 sub sortcmpr {
@@ -531,10 +519,10 @@ sub sortcmpr {
 }
 
 @output = sortcmpr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable $a cmp $b sort return list context';
 $output = sortcmpr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable $a cmp $b sort return scalar context';
 
 sub sortcmprba {
@@ -542,10 +530,10 @@ sub sortcmprba {
 }
 
 @output = sortcmprba &generate;
-ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
+is join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6",
     'reversed stable $b cmp $a sort return list context';
 $output = sortcmprba &generate;
-ok $output, "AAABBBCCC",
+is $output, "AAABBBCCC",
 'reversed stable $b cmp $a sort return scalar context';
 
 sub sortcmprq {
@@ -553,10 +541,10 @@ sub sortcmprq {
 }
 
 @output = sortcmpr &generate;
-ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
+is join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0",
     'reversed stable complex sort return list context';
 $output = sortcmpr &generate;
-ok $output, "CCCBBBAAA",
+is $output, "CCCBBBAAA",
     'reversed stable complex sort return scalar context';
 
 # And now with numbers
@@ -569,148 +557,148 @@ sub generate1 {
 # This won't be very interesting
 @input = &generate1;
 @output = sort {$a cmp $b} @input;
-ok "@output", "A B C D E F G H I", 'stable $a cmp $b sort';
+is "@output", "A B C D E F G H I", 'stable $a cmp $b sort';
 
 @input = &generate1;
 @output = sort {$a <=> $b} @input;
-ok "@output", "A B C D E F G H I", 'stable $a <=> $b sort';
+is "@output", "A B C D E F G H I", 'stable $a <=> $b sort';
 
 @input = &generate1;
 @input = sort {$a <=> $b} @input;
-ok "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort';
+is "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort';
 
 @input = &generate1;
 @output = sort {$b <=> $a} @input;
-ok "@output", "G H I D E F A B C", 'stable $b <=> $a sort';
+is "@output", "G H I D E F A B C", 'stable $b <=> $a sort';
 
 @input = &generate1;
 @input = sort {$b <=> $a} @input;
-ok "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort';
+is "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort';
 
 # test that optimized {$b cmp $a} and {$b <=> $a} remain stable
 # (new in 5.9) without overloading
 { no warnings;
 @b = sort { $b <=> $a } @input = qw/5first 6first 5second 6second/;
-ok "@b" , "6first 6second 5first 5second", "optimized {$b <=> $a} without overloading" ;
+is "@b" , "6first 6second 5first 5second", "optimized {$b <=> $a} without overloading" ;
 @input = sort {$b <=> $a} @input;
-ok "@input" , "6first 6second 5first 5second","inline optimized {$b <=> $a} without overloading" ;
+is "@input" , "6first 6second 5first 5second","inline optimized {$b <=> $a} without overloading" ;
 };
 
 # These two are actually doing string cmp on 0 1 and 2
 @input = &generate1;
 @output = reverse sort @input;
-ok "@output", "I H G F E D C B A", "Reversed stable sort";
+is "@output", "I H G F E D C B A", "Reversed stable sort";
 
 @input = &generate1;
 @input = reverse sort @input;
-ok "@input", "I H G F E D C B A", "Reversed stable in place sort";
+is "@input", "I H G F E D C B A", "Reversed stable in place sort";
 
 @input = &generate1;
 $output = reverse sort @input;
-ok $output, "IHGFEDCBA", "Reversed stable sort in scalar context";
+is $output, "IHGFEDCBA", "Reversed stable sort in scalar context";
 
 @input = &generate1;
 @output = reverse sort {$a <=> $b} @input;
-ok "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort';
+is "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort';
 
 @input = &generate1;
 @input = reverse sort {$a <=> $b} @input;
-ok "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort';
+is "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort';
 
 @input = &generate1;
 $output = reverse sort {$a <=> $b} @input;
-ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort in scalar context';
+is $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort in scalar context';
 
 @input = &generate1;
 @output = reverse sort {$b <=> $a} @input;
-ok "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort';
+is "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort';
 
 @input = &generate1;
 @input = reverse sort {$b <=> $a} @input;
-ok "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort';
+is "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort';
 
 @input = &generate1;
 $output = reverse sort {$b <=> $a} @input;
-ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort in scalar context';
+is $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort in scalar context';
 
 @input = &generate1;
 @output = reverse sort {stuff || $a <=> $b} @input;
-ok "@output", "I H G F E D C B A", 'reversed stable complex sort';
+is "@output", "I H G F E D C B A", 'reversed stable complex sort';
 
 @input = &generate1;
 @input = reverse sort {stuff || $a <=> $b} @input;
-ok "@input", "I H G F E D C B A", 'revesed stable complex in place sort';
+is "@input", "I H G F E D C B A", 'revesed stable complex in place sort';
 
 @input = &generate1;
 $output = reverse sort {stuff || $a <=> $b} @input;
-ok $output, "IHGFEDCBA", 'reversed stable complex sort in scalar context';
+is $output, "IHGFEDCBA", 'reversed stable complex sort in scalar context';
 
 sub sortnumr {
     reverse sort {$a <=> $b} @_;
 }
 
 @output = sortnumr &generate1;
-ok "@output", "I H G F E D C B A",
+is "@output", "I H G F E D C B A",
     'reversed stable $a <=> $b sort return list context';
 $output = sortnumr &generate1;
-ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort return scalar context';
+is $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort return scalar context';
 
 sub sortnumrba {
     reverse sort {$b <=> $a} @_;
 }
 
 @output = sortnumrba &generate1;
-ok "@output", "C B A F E D I H G",
+is "@output", "C B A F E D I H G",
     'reversed stable $b <=> $a sort return list context';
 $output = sortnumrba &generate1;
-ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort return scalar context';
+is $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort return scalar context';
 
 sub sortnumrq {
     reverse sort {stuff || $a <=> $b} @_;
 }
 
 @output = sortnumrq &generate1;
-ok "@output", "I H G F E D C B A",
+is "@output", "I H G F E D C B A",
     'reversed stable complex sort return list context';
 $output = sortnumrq &generate1;
-ok $output, "IHGFEDCBA", 'reversed stable complex sort return scalar context';
+is $output, "IHGFEDCBA", 'reversed stable complex sort return scalar context';
 
 @output = reverse (sort(qw(C A B)), 0);
-ok "@output", "0 C B A", 'reversed sort with trailing argument';
+is "@output", "0 C B A", 'reversed sort with trailing argument';
 
 @output = reverse (0, sort(qw(C A B)));
-ok "@output", "C B A 0", 'reversed sort with leading argument';
+is "@output", "C B A 0", 'reversed sort with leading argument';
 
 eval { @output = sort {goto sub {}} 1,2; };
 $fail_msg = q(Can't goto subroutine outside a subroutine);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr outside subr');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr outside subr');
 
 
 
 sub goto_sub {goto sub{}}
 eval { @output = sort goto_sub 1,2; };
 $fail_msg = q(Can't goto subroutine from a sort sub);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr from a sort sub');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto subr from a sort sub');
 
 
 
 eval { @output = sort {goto label} 1,2; };
 $fail_msg = q(Can't "goto" out of a pseudo block);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 1');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 1');
 
 
 
 sub goto_label {goto label}
 label: eval { @output = sort goto_label 1,2; };
 $fail_msg = q(Can't "goto" out of a pseudo block);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 2');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'goto out of a pseudo block 2');
 
 
 
 sub self_immolate {undef &self_immolate; $a<=>$b}
 eval { @output = sort self_immolate 1,2,3 };
 $fail_msg = q(Can't undef active subroutine);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
+cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
 
 
 
@@ -729,13 +717,12 @@ main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'undef active subr');
     }
 
     rec(1);
-    main::ok(!$failed, "sort from active sub");
+    ok(!$failed, "sort from active sub");
 }
 
 # $a and $b are set in the package the sort() is called from,
 # *not* the package the sort sub is in. This is longstanding
 # de facto behaviour that shouldn't be broken.
-package main;
 my $answer = "good";
 () = sort OtherPack::foo 1,2,3,4;
 
@@ -749,62 +736,68 @@ my $answer = "good";
     }
 }
 
-main::cmp_ok($answer,'eq','good','sort subr called from other package');
+cmp_ok($answer,'eq','good','sort subr called from other package');
 
 
 # Bug 36430 - sort called in package2 while a
 # sort in package1 is active should set $package2::a/b.
-
-$answer = "good";
-my @list = sort { A::min(@$a) <=> A::min(@$b) }
-  [3, 1, 5], [2, 4], [0];
-
-main::cmp_ok($answer,'eq','good','bug 36430');
-
-package A;
-sub min {
-  my @list = sort {
-    $answer = '$a and/or $b are not defined ' if !defined($a) || !defined($b);
-    $a <=> $b;
-  } @_;
-  $list[0];
+{
+    my $answer = "good";
+    my @list = sort { A::min(@$a) <=> A::min(@$b) }
+      [3, 1, 5], [2, 4], [0];
+
+    cmp_ok($answer,'eq','good','bug 36430');
+
+    package A;
+    sub min {
+        my @list = sort {
+            $answer = '$a and/or $b are not defined ' if !defined($a) || !defined($b);
+            $a <=> $b;
+        } @_;
+        $list[0];
+    }
 }
 
+
 # Bug 7567 - an array shouldn't be modifiable while it's being
 # sorted in-place.
-eval { @a=(1..8); @a = sort { @a = (0) } @a; };
-
-$fail_msg = q(Modification of a read-only value attempted);
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
+{
+    eval { @a=(1..8); @a = sort { @a = (0) } @a; };
 
+    $fail_msg = q(Modification of a read-only value attempted);
+    cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
+}
 
 
 # Sorting shouldn't increase the refcount of a sub
-sub foo {(1+$a) <=> (1+$b)}
-my $refcnt = &Internals::SvREFCNT(\&foo);
-@output = sort foo 3,7,9;
-package Foo;
-ok($refcnt, &Internals::SvREFCNT(\&foo), "sort sub refcnt");
-$fail_msg = q(Modification of a read-only value attempted);
-# Sorting a read-only array in-place shouldn't be allowed
-my @readonly = (1..10);
-Internals::SvREADONLY(@readonly, 1);
-eval { @readonly = sort @readonly; };
-main::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'in-place sort of read-only array');
-
-
+{
+    sub foo {(1+$a) <=> (1+$b)}
+    my $refcnt = &Internals::SvREFCNT(\&foo);
+    @output = sort foo 3,7,9;
+
+    {
+        package Foo;
+        ::is($refcnt, &Internals::SvREFCNT(\&foo), "sort sub refcnt");
+        $fail_msg = q(Modification of a read-only value attempted);
+        # Sorting a read-only array in-place shouldn't be allowed
+        my @readonly = (1..10);
+        Internals::SvREADONLY(@readonly, 1);
+        eval { @readonly = sort @readonly; };
+        ::cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'in-place sort of read-only array');
+    }
+}
 
 
 # Using return() should be okay even in a deeper context
 @b = sort {while (1) {return ($a <=> $b)} } 1..10;
-ok("@b", "1 2 3 4 5 6 7 8 9 10", "return within loop");
+is("@b", "1 2 3 4 5 6 7 8 9 10", "return within loop");
 
 # Using return() should be okay even if there are other items
 # on the stack at the time.
 @b = sort {$_ = ($a<=>$b) + do{return $b<=> $a}} 1..10;
-ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
+is("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
 
 # As above, but with a sort sub rather than a sort block.
 sub ret_with_stacked { $_ = ($a<=>$b) + do {return $b <=> $a} }
 @b = sort ret_with_stacked 1..10;
-ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
+is("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
-- 
1.6.2.4

@p5pRT
Copy link
Author

p5pRT commented Jul 12, 2009

From @chipdude

On Sat, Jul 11, 2009 at 06​:06​:51PM +0100, Dave Mitchell wrote​:

The bug affected any utf-8 tr// used within an anonymous sub that gets
cloned at run-time.

Having read the patch description, I get it now...

The pad started as lexical variables only but has morphed into something
much more. I guess the *whole* pad can't be moved into the CXSUB; the bits
that are just storage slots for OPs should still be attached to the CV.

PS​: I'm not sure which was scarier, the bug description or that I understood it
PPS​: Might be nice to see this in 5.10.1
PPPS​: I'm doing testing. Are @​YOU?
--
Chip Salzenberg

@p5pRT
Copy link
Author

p5pRT commented Jul 12, 2009

From @schwern

Shall we call this resolved then?

@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2009

From @rgs

2009/7/12 Michael G Schwern <schwern@​pobox.com>​:

Michael G Schwern wrote​:

Dave Mitchell wrote​:

The clean up patch is not strictly necessary, but it wasn't clear what
package parts of the test file were in.
I tried applying that, but it appears to give spurious output when run
under t/TEST or t/harness​:

    # return with SVs on stack
    # return with SVs on stack

so I've left it for someone else to (hopefully) sort out.

I'll have a look.

Ok, fixed.  The old code had a home rolled Test.pm style ok() that I got rid
of and forgot to change them to is().

Fixed in the branch (force a pull) and also attached.

Thanks, applied.

@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2009

From @clintongormley

PS​: I'm not sure which was scarier, the bug description or that I understood it

Thanks, guys, for putting up with a bad bug report, and for fixing it.

I did spend several hours trying to come up with something reproducible,
but I'm the first to admit that it wouldn't exactly be classified as
"gold-standard"

thanks

Clint

PPS​: Might be nice to see this in 5.10.1
PPPS​: I'm doing testing. Are @​YOU?

@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2009

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

@p5pRT p5pRT closed this as completed Jul 13, 2009
@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2009

From @iabyn

On Sat, Jul 11, 2009 at 06​:11​:35PM -0700, Chip Salzenberg wrote​:

Having read the patch description, I get it now...

The pad started as lexical variables only but has morphed into something
much more. I guess the *whole* pad can't be moved into the CXSUB; the bits
that are just storage slots for OPs should still be attached to the CV.

Yes, any SVs that used to be attached to ops were moved into the pad to
make them ithreads safe/ A bit horrble really, and makes it bug-prone; eg
when freeing up op after compile error, PL_curpad might not be pointing to
the right place.

--
O Unicef Clearasil!
Gibberish and Drivel!
  -- "Bored of the Rings"

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

No branches or pull requests

1 participant