t/basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 #use warnings;
   5
   6 use Test::More tests => 15;
   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 sub Evil::DESTROY {
  43         eval { "oh noes" };
  44 }
  45
  46 lives_ok {
  47         try {
  48                 die "foo";
  49         };
  50 } "basic try";
  51
  52 throws_ok {
  53         try {
  54                 die "foo";
  55         } catch { die $_ };
  56 } qr/foo/, "rethrow";
  57
  58
  59 {
  60         local $@ = "magic";
  61         is( try { 42 }, 42, "try block evaluated" );
  62         is( $@, "magic", '$@ untouched' );
  63 }
  64
  65 {
  66         local $@ = "magic";
  67         is( try { die "foo" }, undef, "try block died" );
  68         is( $@, "magic", '$@ untouched' );
  69 }
  70
  71 {
  72         local $@ = "magic";
  73         like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" );
  74         is( $@, "magic", '$@ untouched' );
  75 }
  76
  77 is( scalar(try { qw(foo bar gorch) }), "gorch", "scalar context" );
  78 is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context" );
  79
  80
  81
  82 {
  83         local $@ = "magic";
  84         local $_ = "other magic";
  85
  86         try {
  87                 my $object = bless { }, "Evil";
  88                 die "foo";
  89         } catch {
  90                 pass("catch invoked");
  91                 local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}";
  92                 like($_, qr/foo/);
  93         };
  94
  95         is( $@, "magic", '$@ untouched' );
  96         is( $_, "other magic", '$_ untouched' );
  97 }