Permalink
Browse files

move throws_like to Test::Util

  • Loading branch information...
1 parent 8cd7b7f commit 8380ccfc9dad2c1ade8af65a23a6f8efaf423df7 @moritz moritz committed Jun 5, 2012
Showing with 53 additions and 36 deletions.
  1. +2 −36 S32-exceptions/misc.t
  2. +51 −0 packages/Test/Util.pm
View
@@ -1,43 +1,9 @@
use v6;
use Test;
+BEGIN { @*INC.push('t/spec/packages/') };
+use Test::Util;
#?DOES 1
-sub throws_like($code, $ex_type, *%matcher) {
- my $msg;
- if $code ~~ Callable {
- $msg = 'code dies';
- $code()
- } else {
- $msg = "'$code' died";
- eval $code;
- }
- ok 0, $msg;
- skip 'Code did not die, can not check exception', 1 + %matcher.elems;
- CATCH {
- default {
- ok 1, $msg;
- my $type_ok = $_ ~~ $ex_type;
- ok $type_ok , "right exception type ({$ex_type.^name})";
- if $type_ok {
- for %matcher.kv -> $k, $v {
- my $got = $_."$k"();
- my $ok = $got ~~ $v,;
- ok $ok, ".$k matches {$v.defined ?? $v !! $v.gist}";
- unless $ok {
- diag "Got: $got\n"
- ~"Expected: $v";
- }
- }
- } else {
- diag "Got: {$_.WHAT.gist}\n"
- ~"Expected: {$ex_type.gist}";
- diag "Exception message: $_.message()";
- skip 'wrong exception type', %matcher.elems;
- }
- }
- }
-}
-
throws_like { Buf.new().Str }, X::Buf::AsStr, method => 'Str';;
throws_like 'pack("B", 1)', X::Buf::Pack, directive => 'B';
throws_like 'Buf.new.unpack("B")', X::Buf::Pack, directive => 'B';
View
@@ -114,6 +114,43 @@ sub get_out( Str $code, Str $input?, :@args) is export {
return %out;
}
+
+sub throws_like($code, $ex_type, *%matcher) is export {
+ my $msg;
+ if $code ~~ Callable {
+ $msg = 'code dies';
+ $code()
+ } else {
+ $msg = "'$code' died";
+ eval $code;
+ }
+ ok 0, $msg;
+ skip 'Code did not die, can not check exception', 1 + %matcher.elems;
+ CATCH {
+ default {
+ ok 1, $msg;
+ my $type_ok = $_ ~~ $ex_type;
+ ok $type_ok , "right exception type ({$ex_type.^name})";
+ if $type_ok {
+ for %matcher.kv -> $k, $v {
+ my $got = $_."$k"();
+ my $ok = $got ~~ $v,;
+ ok $ok, ".$k matches {$v.defined ?? $v !! $v.gist}";
+ unless $ok {
+ diag "Got: $got\n"
+ ~"Expected: $v";
+ }
+ }
+ } else {
+ diag "Got: {$_.WHAT.gist}\n"
+ ~"Expected: {$ex_type.gist}";
+ diag "Exception message: $_.message()";
+ skip 'wrong exception type', %matcher.elems;
+ }
+ }
+ }
+}
+
=begin pod
=head1 NAME
@@ -137,6 +174,20 @@ across Perl 6 implementations.
=head1 FUNCTIONS
+=head2 throws_like($code, Mu $expected_type, *%matchers)
+
+If C<$code> is C<Callable>, calls it, otherwise C<eval>s it,
+and expects it thrown an exception.
+
+If an exception is thrown, it is compared to C<$expected_type>.
+
+Then for each key in C<%matchers>, a method of that name is called
+on the resulting exception, and its return value smart-matched against
+the value.
+
+Each step is counted as a separate test; if one of the first two fails,
+the rest of the tests are skipped.
+
=head2 is_run( Str $code, Str $input?, %wanted, Str $name? )
It runs the code given, feeding it the input given, and collects results

1 comment on commit 8380ccf

Member

kyleha commented on 8380ccf Jun 5, 2012

Dude. I so LOVE throws_like. That is a long ago and far away dream come true. Major moritz++ for that.

Please sign in to comment.