t/53-unwind-misc.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 7;
   7
   8 use Scope::Upper qw<unwind UP SUB>;
   9
  10 {
  11  my @destroyed;
  12
  13  {
  14   package Scope::Upper::TestTimelyDestruction;
  15
  16   sub new {
  17    my ($class, $label) = @_;
  18    bless { label => $label }, $class;
  19   }
  20
  21   sub label { $_[0]->{label} }
  22
  23   sub DESTROY {
  24    push @destroyed, $_[0]->label;
  25   }
  26  }
  27
  28  sub SU_TTD () { 'Scope::Upper::TestTimelyDestruction' }
  29
  30  sub foo {
  31   my $r = SU_TTD->new('a');
  32   my @x = (SU_TTD->new('c'), SU_TTD->new('d'));
  33   unwind 123, $r, SU_TTD->new('b'), @x, sub { SU_TTD->new('e') }->() => UP SUB;
  34  }
  35
  36  sub bar {
  37   foo();
  38   die 'not reached';
  39  }
  40
  41  {
  42   my $desc = sub { "unwinding @_ across a sub" };
  43   my @res = bar();
  44   is $res[0],        123, $desc->('a constant literal');
  45   is $res[1]->label, 'a', $desc->('a lexical');
  46   is $res[2]->label, 'b', $desc->('a temporary object');
  47   is $res[3]->label, 'c', $desc->('the contents of a lexical array (1)');
  48   is $res[4]->label, 'd', $desc->('the contents of a lexical array (2)');
  49   is $res[5]->label, 'e', $desc->('a temporary object returned by a sub');
  50  }
  51
  52  is_deeply \@destroyed, [ qw<e d c b a> ],
  53                                     'all these objects were properly destroyed';
  54 }