X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Frunlevel.t;h=b5e5dbb08c830fdefae3d18c6080432d51f3029f;hb=e336de0d01f30cc4061b6d6a00d11df30fc67cd3;hp=6693a829a882281e5fe592034b308e91da571964;hpb=dfb1c8b93631b1cf8c1d0d2295ffff2bf0f098a7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index 6693a82..b5e5dbb 100755
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -1,17 +1,9 @@
 #!./perl
 
 ##
-## all of these tests are from Michael Schroeder
+## Many of these tests are originally from Michael Schroeder
 ## <Michael.Schroeder@informatik.uni-erlangen.de>
-##
-## The more esoteric failure modes require Michael's
-## stack-of-stacks patch (so we don't test them here,
-## and they are commented out before the __END__).
-##
-## The remaining tests pass with a simpler fix
-## intended for 5.004
-##
-## Gurusamy Sarathy <gsar@umich.edu> 97-02-24
+## Adapted and expanded by Gurusamy Sarathy <gsar@umich.edu>
 ##
 
 chdir 't' if -d 't';
@@ -59,138 +51,6 @@ for (@prgs){
     print "ok ", ++$i, "\n";
 }
 
-=head2 stay out of here (the real tests are after __END__)
-
-##
-## these tests don't pass yet (need the full stack-of-stacks patch)
-## GSAR 97-02-24
-##
-
-########
-# sort within sort
-sub sortfn {
-  (split(/./, 'x'x10000))[0];
-  my (@y) = ( 4, 6, 5);
-  @y = sort { $a <=> $b } @y;
-  print "sortfn ".join(', ', @y)."\n";
-  return $_[0] <=> $_[1];
-}
-@x = ( 3, 2, 1 );
-@x = sort { &sortfn($a, $b) } @x;
-print "---- ".join(', ', @x)."\n";
-EXPECT
-sortfn 4, 5, 6
----- 1, 2, 3
-########
-# trapping eval within sort (doesn't work currently because
-# die does a SWITCHSTACK())
-@a = (3, 2, 1);
-@a = sort { eval('die("no way")') ,  $a <=> $b} @a;
-print join(", ", @a)."\n";
-EXPECT
-1, 2, 3
-########
-# this actually works fine, but results in a poor error message
-@a = (1, 2, 3);
-foo:
-{
-  @a = sort { last foo; } @a;
-}
-EXPECT
-cannot reach destination block at - line 2.
-########
-package TEST;
- 
-sub TIESCALAR {
-  my $foo;
-  return bless \$foo;
-}
-sub FETCH {
-  next;
-  return "ZZZ";
-}
-sub STORE {
-}
- 
-package main;
- 
-tie $bar, TEST;
-{
-  print "- $bar\n";
-}
-print "OK\n";
-EXPECT
-cannot reach destination block at - line 8.
-########
-package TEST;
- 
-sub TIESCALAR {
-  my $foo;
-  return bless \$foo;
-}
-sub FETCH {
-  goto bbb;
-  return "ZZZ";
-}
- 
-package main;
- 
-tie $bar, TEST;
-print "- $bar\n";
-exit;
-bbb:
-print "bbb\n";
-EXPECT
-bbb
-########
-# trapping eval within sort (doesn't work currently because
-# die does a SWITCHSTACK())
-sub foo {
-  $a <=> $b unless eval('$a == 0 ? die("foo\n") : ($a <=> $b)');
-}
-@a = (3, 2, 0, 1);
-@a = sort foo @a;
-print join(', ', @a)."\n";
-EXPECT
-0, 1, 2, 3
-########
-package TEST;
-sub TIESCALAR {
-  my $foo;
-  next;
-  return bless \$foo;
-}
-package main;
-{
-tie $bar, TEST;
-}
-EXPECT
-cannot reach destination block at - line 4.
-########
-# large stack extension causes realloc, and segfault
-package TEST;
-sub TIESCALAR {
-  my $foo;
-  return bless \$foo;
-}
-sub FETCH {
-  return "fetch";
-}
-sub STORE {
-(split(/./, 'x'x10000))[0];
-}
-package main;
-tie $bar, TEST;
-$bar = "x";
-
-=cut
-
-##
-##
-## The real tests begin here
-##
-##
-
 __END__
 @a = (1, 2, 3);
 {
@@ -315,3 +175,121 @@ bar:
 print "bar reached\n";
 EXPECT
 Can't "goto" outside a block at - line 2.
+########
+sub sortfn {
+  (split(/./, 'x'x10000))[0];
+  my (@y) = ( 4, 6, 5);
+  @y = sort { $a <=> $b } @y;
+  print "sortfn ".join(', ', @y)."\n";
+  return $_[0] <=> $_[1];
+}
+@x = ( 3, 2, 1 );
+@x = sort { &sortfn($a, $b) } @x;
+print "---- ".join(', ', @x)."\n";
+EXPECT
+sortfn 4, 5, 6
+---- 1, 2, 3
+########
+@a = (3, 2, 1);
+@a = sort { eval('die("no way")') ,  $a <=> $b} @a;
+print join(", ", @a)."\n";
+EXPECT
+1, 2, 3
+########
+@a = (1, 2, 3);
+foo:
+{
+  @a = sort { last foo; } @a;
+}
+EXPECT
+Label not found for "last foo" at - line 2.
+########
+package TEST;
+ 
+sub TIESCALAR {
+  my $foo;
+  return bless \$foo;
+}
+sub FETCH {
+  next;
+  return "ZZZ";
+}
+sub STORE {
+}
+ 
+package main;
+ 
+tie $bar, TEST;
+{
+  print "- $bar\n";
+}
+print "OK\n";
+EXPECT
+Can't "next" outside a block at - line 8.
+########
+package TEST;
+ 
+sub TIESCALAR {
+  my $foo;
+  return bless \$foo;
+}
+sub FETCH {
+  goto bbb;
+  return "ZZZ";
+}
+ 
+package main;
+ 
+tie $bar, TEST;
+print "- $bar\n";
+exit;
+bbb:
+print "bbb\n";
+EXPECT
+Can't find label bbb at - line 8.
+########
+sub foo {
+  $a <=> $b unless eval('$a == 0 ? die("foo\n") : ($a <=> $b)');
+}
+@a = (3, 2, 0, 1);
+@a = sort foo @a;
+print join(', ', @a)."\n";
+EXPECT
+0, 1, 2, 3
+########
+package TEST;
+sub TIESCALAR {
+  my $foo;
+  return bless \$foo;
+}
+sub FETCH {
+  return "fetch";
+}
+sub STORE {
+(split(/./, 'x'x10000))[0];
+}
+package main;
+tie $bar, TEST;
+$bar = "x";
+########
+package TEST;
+sub TIESCALAR {
+  my $foo;
+  next;
+  return bless \$foo;
+}
+package main;
+{
+tie $bar, TEST;
+}
+EXPECT
+Can't "next" outside a block at - line 4.
+########
+@a = (1, 2, 3);
+foo:
+{
+  @a = sort { exit(0) } @a;
+}
+END { print "foobar\n" }
+EXPECT
+foobar