X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;ds=sidebyside;f=t%2F58-yield-misc.t;fp=t%2F58-yield-misc.t;h=23fc1d4967fc696dd1fcde037886db0ec52cc183;hb=1cac52223ba0983d5d4007ab608fe4ea645eb037;hp=0000000000000000000000000000000000000000;hpb=ca50ad37afae0c65ddc432c03f68d5cefae4de29;p=perl%2Fmodules%2FScope-Upper.git

diff --git a/t/58-yield-misc.t b/t/58-yield-misc.t
new file mode 100644
index 0000000..23fc1d4
--- /dev/null
+++ b/t/58-yield-misc.t
@@ -0,0 +1,76 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 4 * 3;
+
+use lib 't/lib';
+use VPIT::TestHelpers;
+
+use Scope::Upper qw<yield HERE>;
+
+# Test timely destruction of values returned from yield()
+
+our $destroyed;
+sub guard { VPIT::TestHelpers::Guard->new(sub { ++$destroyed }) }
+
+{
+ my $desc = 'scalar context, above';
+ local $destroyed;
+ {
+  my $obj = guard();
+  my $res = do {
+   is $destroyed, undef, "$desc: not yet destroyed 1";
+   yield $obj => HERE;
+   fail 'not reached 1';
+  };
+  is $destroyed, undef, "$desc: not yet destroyed 2";
+ }
+ is $destroyed, 1, "$desc: destroyed 1";
+}
+
+{
+ my $desc = 'scalar context, below';
+ local $destroyed;
+ {
+  my $res = do {
+   my $obj = guard();
+   is $destroyed, undef, "$desc: not yet destroyed 1";
+   yield $obj => HERE;
+   fail 'not reached 1';
+  };
+  is $destroyed, undef, "$desc: not yet destroyed 2";
+ }
+ is $destroyed, 1, "$desc: destroyed 1";
+}
+
+{
+ my $desc = 'void context, above';
+ local $destroyed;
+ {
+  my $obj = guard();
+  {
+   is $destroyed, undef, "$desc: not yet destroyed 1";
+   yield $obj => HERE;
+   fail 'not reached 1';
+  }
+  is $destroyed, undef, "$desc: not yet destroyed 2";
+ }
+ is $destroyed, 1, "$desc: destroyed 1";
+}
+
+{
+ my $desc = 'void context, below';
+ local $destroyed;
+ {
+  {
+   is $destroyed, undef, "$desc: not yet destroyed 1";
+   my $obj = guard();
+   yield $obj => HERE;
+   fail 'not reached 2';
+  }
+  is $destroyed, 1, "$desc: destroyed 1";
+ }
+ is $destroyed, 1, "$desc: destroyed 2";
+}