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 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 { qw(foo bar gorch) }), "gorch", "scalar context" );
  74 is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context" );
  75
  76
  77
  78 sub Evil::DESTROY {
  79         eval { "oh noes" };
  80 }
  81
  82 sub Evil::new { bless { }, $_[0] }
  83
  84 {
  85         local $@ = "magic";
  86         local $_ = "other magic";
  87
  88         try {
  89                 my $object = Evil->new;
  90                 die "foo";
  91         } catch {
  92                 pass("catch invoked");
  93                 local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}";
  94                 like($_, qr/foo/);
  95         };
  96
  97         is( $@, "magic", '$@ untouched' );
  98         is( $_, "other magic", '$_ untouched' );
  99 }