1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
|
#!perl -T
use strict;
use warnings;
use Test::More tests => 7;
use Scope::Upper qw<unwind UP SUB>;
{
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'));
unwind 123, $r, SU_TTD->new('b'), @x, sub { SU_TTD->new('e') }->() => UP SUB;
}
sub bar {
foo();
die 'not reached';
}
{
my $desc = sub { "unwinding @_ 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';
}
|