X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F12-recall.t;h=bc3375d6f3753ae4d48fe475bdf4abfa6c3e8b06;hb=4a302d06092850955b3c6de15940b89b207f1c54;hp=8420cebd93f2be5289d4bceb7d7be901b9abe502;hpb=92b328c090598b186ee6dd5168ca4b5047a834c9;p=perl%2Fmodules%2FSub-Prototype-Util.git diff --git a/t/12-recall.t b/t/12-recall.t index 8420ceb..bc3375d 100644 --- a/t/12-recall.t +++ b/t/12-recall.t @@ -3,27 +3,34 @@ use strict; use warnings; -use Test::More tests => 8 + 20 + (($^V ge v5.10.0) ? 4 : 0); +use Test::More tests => 8 + 20 + (("$]" >= 5.010) ? 4 : 0); -use Scalar::Util qw/set_prototype/; -use Sub::Prototype::Util qw/recall/; +use Scalar::Util; +use Sub::Prototype::Util qw; + +sub exception { + my ($msg) = @_; + $msg =~ s/\s+/\\s+/g; + return qr/^$msg.*?at\s+\Q$0\E\s+line\s+\d+/; +} eval { recall undef }; -like($@, qr/^No\s+subroutine/, 'recall undef croaks'); +like $@, exception('No subroutine'), 'recall undef croaks'; eval { recall '' }; -like($@, qr/^No\s+subroutine/, 'recall "" croaks'); +like $@, exception('No subroutine'), 'recall "" croaks'; eval { recall \1 }; -like($@, qr/^Unhandled\s+SCALAR/, 'recall scalarref croaks'); +like $@, exception('Unhandled SCALAR'), 'recall scalarref croaks'; eval { recall [ ] }; -like($@, qr/^Unhandled\s+ARRAY/, 'recall arrayref croaks'); +like $@, exception('Unhandled ARRAY'), 'recall arrayref croaks'; eval { recall sub { } }; -like($@, qr/^Unhandled\s+CODE/, 'recall coderef croaks'); +like $@, exception('Unhandled CODE'), 'recall coderef croaks'; eval { recall { 'foo' => undef, 'bar' => undef } }; -like($@, qr!exactly\s+one\s+key/value\s+pair!, 'recall hashref with 2 pairs croaks'); +like $@, qr!exactly\s+one\s+key/value\s+pair!, + 'recall hashref with 2 pairs croaks'; eval { recall 'hlagh' }; -like($@, qr/^Undefined\s+subroutine/, 'recall croaks'); +like $@, qr/^Undefined\s+subroutine/, 'recall croaks'; eval { recall 'for' }; -like($@, qr/^syntax\s+error\s+at\s+\Q$0\E/, 'invalid eval code croaks'); +like $@, exception('syntax error'), 'invalid eval code croaks'; sub noproto { $_[1], $_[0] } sub mytrunc ($;$) { $_[1], $_[0] } @@ -49,8 +56,8 @@ my @tests = ( ); sub myit { push @{$_[0]->[2]}, 3; return 4 }; -if ($^V ge v5.10.0) { - set_prototype \&myit, '_'; +if ("$]" >= 5.010) { + Scalar::Util::set_prototype(\&myit, '_'); push @tests, [ 'main::myit', '_ with argument', [ [ 1, 2, [ ] ], 5 ], [ [ 1, 2, [ 3 ] ], 5 ],