diff options
Diffstat (limited to 'cpan/Test-Simple/t/Legacy/fail-like.t')
-rw-r--r-- | cpan/Test-Simple/t/Legacy/fail-like.t | 77 |
1 files changed, 77 insertions, 0 deletions
diff --git a/cpan/Test-Simple/t/Legacy/fail-like.t b/cpan/Test-Simple/t/Legacy/fail-like.t new file mode 100644 index 0000000000..6545507e3a --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/fail-like.t @@ -0,0 +1,77 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +# There was a bug with like() involving a qr// not failing properly. +# This tests against that. + +use strict; + + +# Can't use Test.pm, that's a 5.005 thing. +package My::Test; + +# This has to be a require or else the END block below runs before +# Test::Builder's own and the ending diagnostics don't come out right. +require Test::Builder; +my $TB = Test::Builder->create; +$TB->plan(tests => 4); + + +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; + + +package main; + +require Test::More; +Test::More->import(tests => 1); + +{ + eval q{ like( "foo", qr/that/, 'is foo like that' ); }; + + $TB->is_eq($out->read, <<OUT, 'failing output'); +1..1 +not ok 1 - is foo like that +OUT + + # Accept both old and new-style stringification + my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '\\^' : '-xism'; + + my $err_re = <<ERR; +# Failed test 'is foo like that' +# at .* line 1\. +# 'foo' +# doesn't match '\\(\\?$modifiers:that\\)' +ERR + + $TB->like($err->read, qr/^$err_re$/, 'failing errors'); +} + +{ + # line 62 + like("foo", "not a regex"); + $TB->is_eq($out->read, <<OUT); +not ok 2 +OUT + + $TB->is_eq($err->read, <<OUT); +# Failed test at $0 line 62. +# 'not a regex' doesn't look much like a regex to me. +OUT + +} + +END { + # Test::More thinks it failed. Override that. + $? = scalar grep { !$_ } $TB->summary; +} |