t/basic.t

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