Permalink
Browse files

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

git-svn-id: http://svn.pugscode.org/pugs@28006 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 4856f9e commit 59ffe4c2af2cbfa18d221a9ec0ee4dc31b3c6c0a benmorrow committed Aug 16, 2009
Showing with 168 additions and 2 deletions.
  1. +89 −1 S04-closure-traits/enter-leave.t
  2. +79 −1 S04-closure-traits/pre-post.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
@@ -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

0 comments on commit 59ffe4c

Please sign in to comment.