t/01basic.t

   1 use warnings;
   2 use strict;
   3
   4 use Test::More;
   5 use Exception::Guaranteed;
   6
   7 use lib 't';
   8 use __SelfDestruct;
   9
  10 eval {
  11   guarantee_exception { die "Simple exception" }
  12 };
  13 like( $@, qr/^Simple exception/, 'A plain exception shoots through' );
  14
  15 my $dummy = 0;
  16 my $fail = 0;
  17 eval {
  18   guarantee_exception {
  19     __SelfDestruct->spawn_n_kill(sub {
  20       die 'Exception outer';
  21     });
  22   };
  23
  24   while( $dummy < 2**31) {
  25     $dummy++;
  26   }
  27
  28   $fail = 1;  # we should never reach here
  29 };
  30 print STDERR "\n";
  31 diag( ($dummy||0) . " inc-ops executed before kill-signal delivery (outer g_e)\n" );
  32 ok (!$fail, 'execution stopped after trappable destroy exception');
  33 like( $@, qr/^Exception outer/, 'DESTROY exception thrown and caught from outside' );
  34
  35 $fail = 0;
  36 # when using the fork+signal based approach, I can't make the exception
  37 # happen fast enough to not shoot out of its real containing eval :(
  38 # Hence the dummy count here is essential
  39 $dummy = 0;
  40 eval {
  41   __SelfDestruct->spawn_n_kill( sub {
  42     guarantee_exception {
  43       die 'Exception inner';
  44     };
  45   });
  46
  47   while( $dummy < 2**31) {
  48     $dummy++;
  49   }
  50
  51   $fail = 1;  # we should never reach here
  52 };
  53
  54 diag( ($dummy||0) . " inc-ops executed before kill-signal delivery (DESTROY g_e)\n" );
  55 ok (!$fail, 'execution stopped after trappable destroy exception');
  56 like( $@, qr/^Exception inner/, 'DESTROY exception thrown and caught from inside of DESTROY block' );
  57
  58 # important, for the thread re-test
  59 if ($ENV{EXCEPTION_GUARANTEED_SUBTEST}) {
  60   $ENV{EXCEPTION_GUARANTEED_SUBTEST} = 42;
  61   0; # like an exit(0)
  62 }
  63 else {
  64   done_testing;
  65 }