ext/XS-APItest/t/cleanup.t

   1 use warnings;
   2 use strict;
   3
   4 use Test::More tests => 3;
   5
   6 use XS::APItest qw(establish_cleanup);
   7
   8 my @events;
   9
  10 # unwinding on local return from sub
  11
  12 sub aa {
  13     push @events, "aa0";
  14     establish_cleanup sub { push @events, "bb0" };
  15     push @events, "aa1";
  16     "aa2";
  17 }
  18
  19 sub cc {
  20     push @events, "cc0";
  21     push @events, [ "cc1", aa() ];
  22     push @events, "cc2";
  23     "cc3";
  24 }
  25
  26 @events = ();
  27 push @events, "dd0";
  28 push @events, [ "dd1", cc() ];
  29 is_deeply \@events, [
  30     "dd0",
  31     "cc0",
  32     "aa0",
  33     "aa1",
  34     "bb0",
  35     [ "cc1", "aa2" ],
  36     "cc2",
  37     [ "dd1", "cc3" ],
  38 ];
  39
  40 # unwinding on local return from format
  41
  42 sub ff { push @events, "ff0" }
  43
  44 format EE =
  45 @<<
  46 ((push @events, "ee0"), (establish_cleanup \&ff), (push @events, "ee1"), "ee2")
  47 .
  48
  49 sub gg {
  50     push @events, "gg0";
  51     write(EE);
  52     push @events, "gg1";
  53     "gg2";
  54 }
  55
  56 @events = ();
  57 open EE, ">", \(my $ee);
  58 push @events, "hh0";
  59 push @events, [ "hh1", gg() ];
  60 close EE;
  61 is_deeply \@events, [
  62     "hh0",
  63     "gg0",
  64     "ee0",
  65     "ee1",
  66     "ff0",
  67     "gg1",
  68     [ "hh1", "gg2" ],
  69 ];
  70
  71 # unwinding on die
  72
  73 sub pp {
  74     my $value = eval {
  75         push @events, "pp0";
  76         establish_cleanup sub { push @events, "qq0" };
  77         push @events, "pp1";
  78         die "pp2\n";
  79         push @events, "pp3";
  80         "pp4";
  81     };
  82     [ "pp5", $value, $@ ];
  83 }
  84
  85 @events = ();
  86 push @events, "rr0";
  87 push @events, [  "rr1", pp() ];
  88 is_deeply \@events, [
  89         "rr0",
  90         "pp0",
  91         "pp1",
  92         "qq0",
  93         [ "rr1", [ "pp5", undef, "pp2\n" ] ],
  94 ];
  95
  96 1;