[t/spec] Tests for r28005 (closure traits and exceptions).

git-svn-id: http://svn.pugscode.org/pugs@28006 c213334d-75ef-0310-aa23-eaa082d1ae64

S04-closure-traits/enter-leave.t

@@ -2,7 +2,7 @@ use v6;
 
 use Test;
 
-plan 11;
+plan 19;
 
 # L<S04/Closure traits/ENTER "at every block entry time">
 # L<S04/Closure traits/LEAVE "at every block exit time">
@@ -92,4 +92,92 @@ plan 11;
     }), 1, 'leave triggers LEAVE {}';
 }
 
+{
+    my $str;
+    try {
+        ENTER { $str ~= '(' }
+        LEAVE { $str ~= ')' }
+        $str ~= 'x';
+        die 'foo';
+    }
+    is $str, '(x)', 'die calls LEAVE blocks';
+}
+
+{
+    my $str;
+    try {
+        LEAVE { $str ~= $! // '<undef>' }
+        die 'foo';
+    }
+    is $str, 'foo', '$! set in LEAVE if exception thrown';
+}
+
+{
+    my $str;
+    {
+        LEAVE { $str ~= (defined $! ? 'yes' : 'no') }
+        try { die 'foo' }
+        $str ~= (defined $! ? 'aye' : 'nay');
+    }
+    is $str, 'ayeno', '$! not set in LEAVE if exception not thrown';
+}
+
+{
+    my $str;
+    try {
+        $str ~= '(';
+        try {
+            ENTER { die 'foo' }
+            $str ~= 'x';
+        }
+        $str ~= ')';
+    }
+    is $str, '()', 'die in ENTER caught by try';
+}
+
+{
+    my $str;
+    try {
+        $str ~= '(';
+        try {
+            LEAVE { die 'foo' }
+            $str ~= 'x';
+        }
+        $str ~= ')';
+    }
+    is $str, '(x)', 'die in LEAVE caught by try';
+}
+
+{
+    my $str;
+    try {
+        $str ~= '(';
+        try {
+            ENTER { $str ~= '['; die 'foo' }
+            LEAVE { $str ~= ']' }
+            $str ~= 'x';
+        }
+        $str ~= ')';
+    }
+    is $str, '([])', 'die in ENTER calls LEAVE';
+}
+
+{
+    my $str;
+    try {
+        ENTER { $str ~= '1'; die 'foo' }
+        ENTER { $str ~= '2' }
+    }
+    is $str, '1', 'die aborts ENTER queue';
+}
+
+{
+    my $str;
+    try {
+        LEAVE { $str ~= '1' }
+        LEAVE { $str ~= '2'; die 'foo' }
+    }
+    is $str, '21', 'die doesn\'t abort LEAVE queue';
+}
+
 # vim: ft=perl6

S04-closure-traits/pre-post.t

@@ -9,7 +9,7 @@ use Test;
 # TODO: 
 #  * Multiple inheritance + PRE/POST blocks
 
-plan 18;
+plan 25;
 
 sub foo(Num $i) {
     PRE {
@@ -125,4 +125,82 @@ my $pt = Another.new;
 lives_ok { $pt.test(2) }, 'POST receives return value as $_ (succeess)';
 dies_ok  { $pt.test(1) }, 'POST receives return value as $_ (failure)';
 
+{
+    my $str;
+    {
+        PRE  { $str ~= '('; 1 }
+        POST { $str ~= ')'; 1 }
+        $str ~= 'x';
+    }
+    is $str, '(x)', 'PRE and POST run on ordinary blocks';
+}
+
+{
+    my $str;
+    {
+        POST  { $str ~= ')'; 1 }
+        LEAVE { $str ~= ']' }
+        ENTER { $str ~= '[' }
+        PRE   { $str ~= '('; 1 }
+        $str ~= 'x';
+    }
+    is $str, '([x])', 'PRE/POST run outside ENTER/LEAVE';
+}
+
+{
+    my $str;
+    try {
+        {
+            PRE     { $str ~= '('; 0 }
+            PRE     { $str ~= '*'; 1 }
+            ENTER   { $str ~= '[' }
+            $str ~= 'x';
+            LEAVE   { $str ~= ']' }
+            POST    { $str ~= ')'; 1 }
+        }
+    }
+    is $str, '(', 'failing PRE runs nothing else';
+}
+
+{
+    my $str;
+    try {
+        {
+            POST  { $str ~= 'x'; 0 }
+            LEAVE { $str ~= 'y' }
+            POST  { $str ~= 'z'; 1 }
+        }
+    }
+    is $str, 'yx', 'failing POST runs LEAVE but not more POSTs';
+}
+
+{
+    my $str;
+    try {
+        POST { $str ~= $! // '<undef>'; 1 }
+        die 'foo';
+    }
+    is $str, 'foo', 'POST runs on exception, with correct $!';
+}
+
+{
+    my $str;
+    try {
+        POST { $str ~= (defined $! ? 'yes' : 'no'); 1 }
+        try { die 'foo' }
+        $str ~= (defined $! ? 'aye' : 'nay');
+    }
+    is $str, 'ayeno', 'POST has undef $! on no exception';
+}
+
+{
+    try {
+        POST { 0 }
+        die 'foo';
+    }
+    is $!, 'foo', 'failing POST on exception doesn\'t replace $!';
+    # XXX
+    # is $!.pending.[-1], 'a POST exception', 'does push onto $!.pending';
+}
+
 # vim: ft=perl6