X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fpragma%2Fwarn%2Fpp_ctl;h=5e0dd2766c61737d96e346ac7934151bfb1d06f3;hb=4438c4b75b842b6c829a7da9841e97abb875b1d8;hp=e017d8a0a810f22d8a88a5cec9c2018e1cc0b25b;hpb=b37043115f92ac73bfe3a2939d40e00a12f9f215;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl
index e017d8a..5e0dd27 100644
--- a/t/pragma/warn/pp_ctl
+++ b/t/pragma/warn/pp_ctl
@@ -53,10 +53,14 @@
 	 
 	goto &fred()
 
+      (in cleanup) foo bar
+	package Foo;
+	DESTROY { die "foo bar" }
+	{ bless [], 'Foo' for 1..10 }
 
 __END__
 # pp_ctl.c
-use warning 'syntax' ;
+use warnings 'syntax' ;
 format STDOUT =
 @<<< @<<<
 1
@@ -67,73 +71,111 @@ Not enough format arguments at - line 5.
 1
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
+no warnings 'syntax' ;
+format =
+@<<< @<<<
+1
+.
+write ;
+EXPECT
+1
+########
+# pp_ctl.c
+use warnings 'unsafe' ;
 $_ = "abc" ;
  
 while ($i ++ == 0)
 {
     s/ab/last/e ;
 }
+no warnings 'unsafe' ;
+while ($i ++ == 0)
+{
+    s/ab/last/e ;
+}
 EXPECT
 Exiting substitution via last at - line 7.
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
+use warnings 'unsafe' ;
 sub fred { last }
 { fred() }
+no warnings 'unsafe' ;
+sub joe { last }
+{ joe() }
 EXPECT
 Exiting subroutine via last at - line 3.
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
-{ eval "last" } 
+{
+  eval "use warnings 'unsafe' ; last;" 
+}
+print STDERR $@ ;
+{
+  eval "no warnings 'unsafe' ;last;" 
+} 
 print STDERR $@ ;
 EXPECT
 Exiting eval via last at (eval 1) line 1.
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
+use warnings 'unsafe' ;
 @a = (1,2) ;
 @b = sort { last } @a ;
+no warnings 'unsafe' ;
+@b = sort { last } @a ;
 EXPECT
 Exiting pseudo-block via last at - line 4.
 Can't "last" outside a block at - line 4.
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
+use warnings 'unsafe' ;
 $_ = "abc" ;
 fred: 
 while ($i ++ == 0)
 {
     s/ab/last fred/e ;
 }
+no warnings 'unsafe' ;
+while ($i ++ == 0)
+{
+    s/ab/last fred/e ;
+}
 EXPECT
 Exiting substitution via last at - line 7.
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
+use warnings 'unsafe' ;
 sub fred { last joe }
 joe: { fred() }
+no warnings 'unsafe' ;
+sub Fred { last Joe }
+Joe: { Fred() }
 EXPECT
 Exiting subroutine via last at - line 3.
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
-joe: { eval "last joe" }
+joe:
+{ eval "use warnings 'unsafe' ; last joe;" }
+print STDERR $@ ;
+Joe:
+{ eval "no warnings 'unsafe' ; last Joe;" }
 print STDERR $@ ;
 EXPECT
-Exiting eval via last at (eval 1) line 2.
+Exiting eval via last at (eval 1) line 1.
 ########
 # pp_ctl.c
-use warning 'unsafe' ;
+use warnings 'unsafe' ;
 @a = (1,2) ;
 fred: @b = sort { last fred } @a ;
+no warnings 'unsafe' ;
+Fred: @b = sort { last Fred } @a ;
 EXPECT
 Exiting pseudo-block via last at - line 4.
 Label not found for "last fred" at - line 4.
 ########
 # pp_ctl.c
-use warning 'recursion' ;
+use warnings 'recursion' ;
 BEGIN { warn "PREFIX\n" ;}
 sub fred
 {
@@ -143,3 +185,34 @@ sub fred
 goto &fred()
 EXPECT
 Deep recursion on subroutine "main::fred" at - line 6.
+########
+# pp_ctl.c
+no warnings 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+    goto &fred() if $a++ < 200
+}
+ 
+goto &fred()
+EXPECT
+Can't find label
+########
+# pp_ctl.c
+use warnings 'unsafe' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+	(in cleanup) A foo bar at - line 4.
+	(in cleanup) B foo bar at - line 4.
+########
+# pp_ctl.c
+no warnings 'unsafe' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+