t/basic.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 25;
   5 use Try::Tiny;
   6
   7 sub _eval {
   8   local $@;
   9   local $Test::Builder::Level = $Test::Builder::Level + 2;
  10   return ( scalar(eval { $_[0]->(); 1 }), $@ );
  11 }
  12
  13
  14 sub lives_ok (&$) {
  15   my ( $code, $desc ) = @_;
  16   local $Test::Builder::Level = $Test::Builder::Level + 1;
  17
  18   my ( $ok, $error ) = _eval($code);
  19
  20   ok($ok, $desc );
  21
  22   diag "error: $@" unless $ok;
  23 }
  24
  25 sub throws_ok (&$$) {
  26   my ( $code, $regex, $desc ) = @_;
  27   local $Test::Builder::Level = $Test::Builder::Level + 1;
  28
  29   my ( $ok, $error ) = _eval($code);
  30
  31   if ( $ok ) {
  32     fail($desc);
  33   } else {
  34     like($error || '', $regex, $desc );
  35   }
  36 }
  37
  38
  39 my $prev;
  40
  41 lives_ok {
  42   try {
  43     die "foo";
  44   };
  45 } "basic try";
  46
  47 throws_ok {
  48   try {
  49     die "foo";
  50   } catch { die $_ };
  51 } qr/foo/, "rethrow";
  52
  53
  54 {
  55   local $@ = "magic";
  56   is( try { 42 }, 42, "try block evaluated" );
  57   is( $@, "magic", '$@ untouched' );
  58 }
  59
  60 {
  61   local $@ = "magic";
  62   is( try { die "foo" }, undef, "try block died" );
  63   is( $@, "magic", '$@ untouched' );
  64 }
  65
  66 {
  67   local $@ = "magic";
  68   like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" );
  69   is( $@, "magic", '$@ untouched' );
  70 }
  71
  72 is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context try" );
  73 is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context try" );
  74
  75 is( scalar(try { die } catch { "foo", "bar", "gorch" }), "gorch", "scalar context catch" );
  76 is_deeply( [ try { die } catch {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context catch" );
  77
  78
  79 {
  80   my ($sub) = catch { my $a = $_; };
  81   is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
  82 }
  83
  84 {
  85   my ($sub) = finally { my $a = $_; };
  86   is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
  87 }
  88
  89 lives_ok {
  90   try {
  91     die "foo";
  92   } catch {
  93     my $err = shift;
  94
  95     try {
  96       like $err, qr/foo/;
  97     } catch {
  98       fail("shouldn't happen");
  99     };
 100
 101     pass "got here";
 102   }
 103 } "try in try catch block";
 104
 105 throws_ok {
 106   try {
 107     die "foo";
 108   } catch {
 109     my $err = shift;
 110
 111     try { } catch { };
 112
 113     die "rethrowing $err";
 114   }
 115 } qr/rethrowing foo/, "rethrow with try in catch block";
 116
 117
 118 sub Evil::DESTROY {
 119   eval { "oh noes" };
 120 }
 121
 122 sub Evil::new { bless { }, $_[0] }
 123
 124 {
 125   local $@ = "magic";
 126   local $_ = "other magic";
 127
 128   try {
 129     my $object = Evil->new;
 130     die "foo";
 131   } catch {
 132     pass("catch invoked");
 133     local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}" if "$]" < 5.014;
 134     like($_, qr/foo/);
 135   };
 136
 137   is( $@, "magic", '$@ untouched' );
 138   is( $_, "other magic", '$_ untouched' );
 139 }
 140
 141 {
 142   my ( $caught, $prev );
 143
 144   {
 145     local $@;
 146
 147     eval { die "bar\n" };
 148
 149     is( $@, "bar\n", 'previous value of $@' );
 150
 151     try {
 152       die {
 153         prev => $@,
 154       }
 155     } catch {
 156       $caught = $_;
 157       $prev = $@;
 158     }
 159   }
 160
 161   is_deeply( $caught, { prev => "bar\n" }, 'previous value of $@ available for capture' );
 162   is( $prev, "bar\n", 'previous value of $@ also available in catch block' );
 163 }