Add CONTROL blocks

perl6 · Nov 25, 2009 · 7387be6 · 7387be6
1 parent ef7eef0
commit 7387be6
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 3 deletions.
diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
@@ -163,10 +163,23 @@ method statement_control:sym<return>($/) {
 }
 
 method statement_control:sym<CATCH>($/) {
+    my $block := $<block>.ast;
+    push_block_handler($/, $block);
+    @BLOCK[0].handlers()[0].handle_types_except('CONTROL');
+    make PAST::Stmts.new(:node($/));
+}
+
+method statement_control:sym<CONTROL>($/) {
+    my $block := $<block>.ast;
+    push_block_handler($/, $block);
+    @BLOCK[0].handlers()[0].handle_types('CONTROL');
+    make PAST::Stmts.new(:node($/));
+}
+
+sub push_block_handler($/, $block) {
     unless @BLOCK[0].handlers() {
         @BLOCK[0].handlers([]);
     }
-    my $block := $<block>.ast;
     unless $block.arity {
         $block.unshift(
             PAST::Op.new( :pasttype('bind'),
@@ -182,7 +195,6 @@ method statement_control:sym<CATCH>($/) {
     $block.blocktype('declaration');
     @BLOCK[0].handlers.unshift(
         PAST::Control.new(
-            :handle_types_except('CONTROL'),
             :node($/),
             PAST::Stmts.new(
                 PAST::Op.new( :pasttype('call'),
@@ -199,7 +211,6 @@ method statement_control:sym<CATCH>($/) {
             ),
         )
     );
-    make PAST::Stmts.new(:node($/));
 }
 
 method statement_prefix:sym<INIT>($/) {

diff --git a/src/NQP/Grammar.pm b/src/NQP/Grammar.pm
@@ -182,6 +182,11 @@ token statement_control:sym<CATCH> {
     <block>
 }
 
+token statement_control:sym<CONTROL> {
+    <sym> \s :s
+    <block>
+}
+
 proto token statement_prefix { <...> }
 token statement_prefix:sym<INIT> { <sym> <blorst> }
 

diff --git a/t/nqp/44-try-catch.t b/t/nqp/44-try-catch.t
@@ -67,3 +67,11 @@ $ok := 1;
 }
 
 ok($ok == 16, "resuming from resumable exceptions works");
+
+$ok := 0;
+{
+    CATCH { $ok := -1; }
+    CONTROL { $ok := 1; }
+    return 5;
+}
+ok($ok == 1, "CONTROL blocks catch control exceptions");