t/basic.t

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