summaryrefslogtreecommitdiff
path: root/t/op
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1998-04-03 06:59:37 +0000
committerGurusamy Sarathy <gsar@cpan.org>1998-04-03 06:59:37 +0000
commite336de0d01f30cc4061b6d6a00d11df30fc67cd3 (patch)
tree47af4eae88807f461d216a10701a0502a2373226 /t/op
parentdfb1c8b93631b1cf8c1d0d2295ffff2bf0f098a7 (diff)
downloadperl-e336de0d01f30cc4061b6d6a00d11df30fc67cd3.tar.gz
[win32] implement stack-of-stacks so that magic invocations don't
invalidate local stack pointer p4raw-id: //depot/win32/perl@864
Diffstat (limited to 't/op')
-rwxr-xr-xt/op/runlevel.t262
1 files changed, 120 insertions, 142 deletions
diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index 6693a829a8..b5e5dbb08c 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