File: 53-unwind-misc.t

package info (click to toggle)
libscope-upper-perl 0.25-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 536 kB
  • ctags: 78
  • sloc: perl: 6,745; makefile: 7
file content (54 lines) | stat: -rw-r--r-- 1,208 bytes parent folder | download | duplicates (5)
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';
}