This patch adds a test to t/06sub.t to check that a closure returned by
a subroutine can find the variable that it is closed on.
But in writing this test I found that "if (die 'foo') { }" doesn't die, so a
test for that has been added to t/base/if.t.
And finally "my $foo; eval '$foo = die "bool"'; $foo;" does die, but at
the $foo.
--
Benjamin Smith <[EMAIL PROTECTED], [EMAIL PROTECTED]>
Index: t/06sub.t
===================================================================
--- t/06sub.t (revision 194)
+++ t/06sub.t (working copy)
@@ -1,7 +1,7 @@
use v6;
my $loop = 1;
-say "1..10";
+say "1..12";
sub foobar ($var) {
return $var;
@@ -49,5 +49,20 @@
}
if (callerunderscore() eq "-bar-") { say "ok 10" } else { say "not ok 10 #
TODO CALLER::" }
-
-
+# Check that closures are closed over variables they do use
+# if they don't undefined variable exceptions get thrown
+sub createclosure_sub () {
+ my $a = "-wibble-";
+ return sub { $a };
+}
+sub createclosure_block () {
+ my $a = "-quux-";
+ return { $a };
+}
+my $sub = createclosure_sub();
+my $block = createclosure_block();
+my $_ = "not-wibble-or-quux";
+$_ = $sub.();
+if ($_ eq "-wibble-") { say "ok 11" } else { say "not ok 11" }
+$_ = $block.();
+if ($_ eq "-quux-") { say "ok 12" } else { say "not ok 12" }
Index: t/base/if.t
===================================================================
--- t/base/if.t (revision 194)
+++ t/base/if.t (working copy)
@@ -6,8 +6,15 @@
=cut
-say "1..2";
+say "1..3";
my $x = 'test';
if ($x eq $x) { say "ok 1"; } else { say "not ok 1"; }
if ($x ne $x) { say "not ok 2"; } else { say "ok 2"; }
+
+# die called in the condition part of an if statement should die immediately
+# rather than being evaluated as true
+my $foo = 1;
+eval 'if (die "should die") { $foo = 3 } else { $foo = 2; }';
+say '# $foo = ' ~ $foo;
+if ($foo == 1) { say "ok 3"; } else { say "not ok 3" }
Index: t/op/die.t
===================================================================
--- t/op/die.t (revision 194)
+++ t/op/die.t (working copy)
@@ -1,8 +1,15 @@
use v6;
-say "1..2";
+say "1..3";
if (eval 'die "foo"; 1') { say "not ok 1" } else { say "ok 1" };
my $error;
eval '$error = $!'; # pugs does not know $! yet
if ($error eq 'foo' ) { say "ok 2 # TODO die" } else { say "not ok 2 # TODO
die" }
+
+my $foo = "-foo-";
+eval '$foo = die "bar"';
+$foo; # this is testing for a bug where an error is stored into $foo in
+ # the above eval; unfortunately the if below doesn't detect this on it's
+ # own, so this lone $foo will die if the bug is present
+if ($foo eq "-foo-") { say "ok 3" } else { say "not ok 3" }
