X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F58-yield-misc.t;h=e89e8926ceb5cbac39232c04f780d14b6e0b4780;hb=3beb96a81eebadf62454ea90eecd4b9dd36bdce5;hp=ca6fda079334e27586e939bab85fb4259c7c39ac;hpb=3852d1e712b2e4f5c1ab14efe303ce7d7a95464d;p=perl%2Fmodules%2FScope-Upper.git

diff --git a/t/58-yield-misc.t b/t/58-yield-misc.t
index ca6fda0..e89e892 100644
--- a/t/58-yield-misc.t
+++ b/t/58-yield-misc.t
@@ -3,12 +3,12 @@
 use strict;
 use warnings;
 
-use Test::More tests => 4 * 3 + 1 + 3;
+use Test::More tests => 4 * 3 + 1 + 3 + 7;
 
 use lib 't/lib';
 use VPIT::TestHelpers;
 
-use Scope::Upper qw<yield leave HERE>;
+use Scope::Upper qw<yield leave HERE UP SUB>;
 
 # Test timely destruction of values returned from yield()
 
@@ -121,7 +121,9 @@ sub guard { VPIT::TestHelpers::Guard->new(sub { ++$destroyed }) }
  is "@res", '1 2 3 4', 'leave with arguments';
 }
 
-{
+SKIP: {
+ skip '"eval { $str =~ s/./die q[foo]/e }" breaks havoc on perl 5.8 and below'
+                                                           => 1 if "$]" < 5.010;
  my $s = 'a';
  local $@;
  eval {
@@ -133,3 +135,49 @@ sub guard { VPIT::TestHelpers::Guard->new(sub { ++$destroyed }) }
       qr/^leave\(\) can't target a substitution context at \Q$0\E line $line/,
       'leave() cannot exit subst';
 }
+
+{
+ my @destroyed;
+
+ {
+  package Scope::Upper::TestTimelyDestruction;
+
+  sub new {
+   my ($class, $label) = @_;
+   bless { label => $label }, $class;
+  }
+
+  sub label { $_[0]->{label} }
+
+  sub DESTROY {
+   push @destroyed, $_[0]->label;
+  }
+ }
+
+ sub SU_TTD () { 'Scope::Upper::TestTimelyDestruction' }
+
+ sub foo {
+  my $r = SU_TTD->new('a');
+  my @x = (SU_TTD->new('c'), SU_TTD->new('d'));
+  yield 123, $r, SU_TTD->new('b'), @x, sub { SU_TTD->new('e') }->() => UP SUB;
+ }
+
+ sub bar {
+  foo();
+  die 'not reached';
+ }
+
+ {
+  my $desc = sub { "yielding @_ across a sub" };
+  my @res = bar();
+  is $res[0],        123, $desc->('a constant literal');
+  is $res[1]->label, 'a', $desc->('a lexical');
+  is $res[2]->label, 'b', $desc->('a temporary object');
+  is $res[3]->label, 'c', $desc->('the contents of a lexical array (1)');
+  is $res[4]->label, 'd', $desc->('the contents of a lexical array (2)');
+  is $res[5]->label, 'e', $desc->('a temporary object returned by a sub');
+ }
+
+ is_deeply \@destroyed, [ qw<e d c b a> ],
+                                    'all these objects were properly destroyed';
+}