Sorry for the delay in replying, but I was busy with other things and I
wanted to give other people a chance to reply. Since noone has, might it
be possible to get the attached patches committed? I'm not familiar with
the protocol for such things so, again, I'm sorry if I've got it wrong.
Ben
--- S04-control.pod.orig 2009-08-11 08:43:36.000000000 +0100
+++ S04-control.pod 2009-08-11 09:03:42.000000000 +0100
@@ -1232,6 +1232,21 @@
before C<BEGIN>, C<CHECK>, or C<INIT>, since those are done at compile or
process initialization time).
+If an exception is thrown through a block without a C<CATCH> block, the
+C<LEAVE>, C<UNDO> and C<POST> blocks will be run at that point, with
+C<$!> set to the in-flight exception. If there is no in-flight
+exception when these blocks are run, C<$!> will be C<undef>. The last
+exception caught in the outer block is available as C<< OUTER::<$!> >>,
+as usual.
+
+An exception thrown from an C<ENTER> block will abort the C<ENTER>
+queue, but one thrown from a C<LEAVE> block will not. The exceptions
+thrown by failing C<PRE> and C<POST> blocks cannot be caught by a
+C<CATCH> in the same block, which implies that C<POST> blocks are not
+run if a C<PRE> block fails. If a C<POST> fails while an exception is in
+flight the C<POST> failure doesn't replace C<$!> but goes straight into
+C<$!.pending>.
+
For blocks such as C<KEEP> and C<POST> that are run when exiting a
scope normally, the return value (if any) from that scope is available
as the current topic. (It is presented as a C<Capture> object.)
Index: S04-closure-traits/enter-leave.t
===================================================================
--- S04-closure-traits/enter-leave.t (revision 27955)
+++ S04-closure-traits/enter-leave.t (working copy)
@@ -2,7 +2,7 @@
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 @@
}), 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
Index: S04-closure-traits/pre-post.t
===================================================================
--- S04-closure-traits/pre-post.t (revision 27955)
+++ S04-closure-traits/pre-post.t (working copy)
@@ -9,7 +9,7 @@
# TODO:
# * Multiple inheritance + PRE/POST blocks
-plan 18;
+plan 25;
sub foo(Num $i) {
PRE {
@@ -125,4 +125,82 @@
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
