From 7387be6cd758a37d883c6b3f475d8cda11a448dd Mon Sep 17 00:00:00 2001
From: Stephen Weeks <tene@allalone.org>
Date: Wed, 25 Nov 2009 11:49:10 -0700
Subject: [PATCH] Add CONTROL blocks

---
 src/NQP/Actions.pm   | 17 ++++++++++++++---
 src/NQP/Grammar.pm   |  5 +++++
 t/nqp/44-try-catch.t |  8 ++++++++
 3 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
index d2a0578..b3efb3a 100644
--- 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
index 9b25d56..9dacad9 100644
--- 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
index 864c38e..8424b00 100644
--- 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");