[p5sagit/p5-mst-13.2.git] / lib / Test / Simple / t / fail-more.t

#!perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;

require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
local $ENV{HARNESS_ACTIVE} = 0;


# 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 => 17);

sub like ($$;$) {
    $TB->like(@_);
}

sub is ($$;$) {
    $TB->is_eq(@_);
}

sub main::err_ok ($) {
    my($expect) = @_;
    my $got = $err->read;

    return $TB->is_eq( $got, $expect );
}


package main;

require Test::More;
my $Total = 29;
Test::More->import(tests => $Total);

my $tb = Test::More->builder;
$tb->use_numbers(0);

my $Filename = quotemeta $0;

# Preserve the line numbers.
#line 38
ok( 0, 'failing' );
err_ok( <<ERR );
#   Failed test 'failing'
#   at $0 line 38.
ERR

#line 40
is( "foo", "bar", 'foo is bar?');
is( undef, '',    'undef is empty string?');
is( undef, 0,     'undef is 0?');
is( '',    0,     'empty string is 0?' );
err_ok( <<ERR );
#   Failed test 'foo is bar?'
#   at $0 line 40.
#          got: 'foo'
#     expected: 'bar'
#   Failed test 'undef is empty string?'
#   at $0 line 41.
#          got: undef
#     expected: ''
#   Failed test 'undef is 0?'
#   at $0 line 42.
#          got: undef
#     expected: '0'
#   Failed test 'empty string is 0?'
#   at $0 line 43.
#          got: ''
#     expected: '0'
ERR

#line 45
isnt("foo", "foo", 'foo isnt foo?' );
isn't("foo", "foo",'foo isn\'t foo?' );
isnt(undef, undef, 'undef isnt undef?');
err_ok( <<ERR );
#   Failed test 'foo isnt foo?'
#   at $0 line 45.
#     'foo'
#         ne
#     'foo'
#   Failed test 'foo isn\'t foo?'
#   at $0 line 46.
#     'foo'
#         ne
#     'foo'
#   Failed test 'undef isnt undef?'
#   at $0 line 47.
#     undef
#         ne
#     undef
ERR

#line 48
like( "foo", '/that/',  'is foo like that' );
unlike( "foo", '/foo/', 'is foo unlike foo' );
err_ok( <<ERR );
#   Failed test 'is foo like that'
#   at $0 line 48.
#                   'foo'
#     doesn't match '/that/'
#   Failed test 'is foo unlike foo'
#   at $0 line 49.
#                   'foo'
#           matches '/foo/'
ERR

# Nick Clark found this was a bug.  Fixed in 0.40.
# line 60
like( "bug", '/(%)/',   'regex with % in it' );
err_ok( <<ERR );
#   Failed test 'regex with % in it'
#   at $0 line 60.
#                   'bug'
#     doesn't match '/(%)/'
ERR

#line 67
fail('fail()');
err_ok( <<ERR );
#   Failed test 'fail()'
#   at $0 line 67.
ERR

#line 52
can_ok('Mooble::Hooble::Yooble', qw(this that));
can_ok('Mooble::Hooble::Yooble', ());
can_ok(undef, undef);
err_ok( <<ERR );
#   Failed test 'Mooble::Hooble::Yooble->can(...)'
#   at $0 line 52.
#     Mooble::Hooble::Yooble->can('this') failed
#     Mooble::Hooble::Yooble->can('that') failed
#   Failed test 'Mooble::Hooble::Yooble->can(...)'
#   at $0 line 53.
#     can_ok() called with no methods
#   Failed test '->can(...)'
#   at $0 line 54.
#     can_ok() called with empty class or reference
ERR

#line 55
isa_ok(bless([], "Foo"), "Wibble");
isa_ok(42,    "Wibble", "My Wibble");
isa_ok(undef, "Wibble", "Another Wibble");
isa_ok([],    "HASH");
err_ok( <<ERR );
#   Failed test 'The object isa Wibble'
#   at $0 line 55.
#     The object isn't a 'Wibble' it's a 'Foo'
#   Failed test 'My Wibble isa Wibble'
#   at $0 line 56.
#     My Wibble isn't a reference
#   Failed test 'Another Wibble isa Wibble'
#   at $0 line 57.
#     Another Wibble isn't defined
#   Failed test 'The object isa HASH'
#   at $0 line 58.
#     The object isn't a 'HASH' it's a 'ARRAY'
ERR

#line 68
cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
cmp_ok( 42.1,  '==', 23,  , '       ==' );
cmp_ok( 42,    '!=', 42   , '       !=' );
cmp_ok( 1,     '&&', 0    , '       &&' );
err_ok( <<ERR );
#   Failed test 'cmp_ok eq'
#   at $0 line 68.
#          got: 'foo'
#     expected: 'bar'
#   Failed test '       =='
#   at $0 line 69.
#          got: 42.1
#     expected: 23
#   Failed test '       !='
#   at $0 line 70.
#     '42'
#         !=
#     '42'
#   Failed test '       &&'
#   at $0 line 71.
#     '1'
#         &&
#     '0'
ERR


# line 196
cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
err_ok( <<ERR );
#   Failed test '       eq with numbers'
#   at $0 line 196.
#          got: '42'
#     expected: 'foo'
ERR


{
    my $warnings;
    local $SIG{__WARN__} = sub { $warnings .= join '', @_ };

# line 211
    cmp_ok( 42,    '==', "foo", '       == with strings' );
    err_ok( <<ERR );
#   Failed test '       == with strings'
#   at $0 line 211.
#          got: 42
#     expected: foo
ERR
    My::Test::like $warnings,
     qq[/^Argument "foo" isn't numeric in .* at $Filename line 211\\\.\n\$/];

}


# generate a $!, it changes its value by context.
-e "wibblehibble";
my $Errno_Number = $!+0;
my $Errno_String = $!.'';
#line 80
cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
err_ok( <<ERR );
#   Failed test '       eq with stringified errno'
#   at $0 line 80.
#          got: '$Errno_String'
#     expected: ''
#   Failed test '       eq with numerified errno'
#   at $0 line 81.
#          got: $Errno_Number
#     expected: -1
ERR

#line 84
use_ok('Hooble::mooble::yooble');

my $more_err_re = <<ERR;
#   Failed test 'use Hooble::mooble::yooble;'
#   at $Filename line 84\\.
#     Tried to use 'Hooble::mooble::yooble'.
#     Error:  Can't locate Hooble.* in \\\@INC .*
# BEGIN failed--compilation aborted at $Filename line 84.
ERR

My::Test::like($err->read, "/^$more_err_re/");


#line 85
require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
$more_err_re = <<ERR;
#   Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
#   at $Filename line 85\\.
#     Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
#     Error:  Can't locate ALL.* in \\\@INC .*
ERR

My::Test::like($err->read, "/^$more_err_re/");


#line 88
END {
    $TB->is_eq($$out, <<OUT, 'failing output');
1..$Total
not ok - failing
not ok - foo is bar?
not ok - undef is empty string?
not ok - undef is 0?
not ok - empty string is 0?
not ok - foo isnt foo?
not ok - foo isn't foo?
not ok - undef isnt undef?
not ok - is foo like that
not ok - is foo unlike foo
not ok - regex with % in it
not ok - fail()
not ok - Mooble::Hooble::Yooble->can(...)
not ok - Mooble::Hooble::Yooble->can(...)
not ok - ->can(...)
not ok - The object isa Wibble
not ok - My Wibble isa Wibble
not ok - Another Wibble isa Wibble
not ok - The object isa HASH
not ok - cmp_ok eq
not ok -        ==
not ok -        !=
not ok -        &&
not ok -        eq with numbers
not ok -        == with strings
not ok -        eq with stringified errno
not ok -        eq with numerified errno
not ok - use Hooble::mooble::yooble;
not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
OUT

err_ok( <<ERR );
# Looks like you failed $Total tests of $Total.
ERR

    exit(0);
}
Commit	Line	Data
33459055	1	#!perl -w
3f2ec160	2
15db8fc4	3	BEGIN {
a9153838	4	if( $ENV{PERL_CORE} ) {
	5	chdir 't';
	6	@INC = ('../lib', 'lib');
	7	}
	8	else {
	9	unshift @INC, 't/lib';
	10	}
15db8fc4	11	}
15db8fc4	12
33459055	13	use strict;
33459055	14
	15	require Test::Simple::Catch;
	16	my($out, $err) = Test::Simple::Catch::caught();
30e302f8	17	local $ENV{HARNESS_ACTIVE} = 0;
33459055	18
33459055	19
3f2ec160	20	# Can't use Test.pm, that's a 5.005 thing.
	21	package My::Test;
	22
b1ddf169	23	# This has to be a require or else the END block below runs before
	24	# Test::Builder's own and the ending diagnostics don't come out right.
	25	require Test::Builder;
	26	my $TB = Test::Builder->create;
	27	$TB->plan(tests => 17);
	28
	29	sub like ($$;$) {
	30	$TB->like(@_);
3f2ec160	31	}
3f2ec160	32
b1ddf169	33	sub is ($$;$) {
	34	$TB->is_eq(@_);
	35	}
3f2ec160	36
0257f296	37	sub main::err_ok ($) {
30e302f8	38	my($expect) = @_;
	39	my $got = $err->read;
	40
b1ddf169	41	return $TB->is_eq( $got, $expect );
30e302f8	42	}
	43
	44
3f2ec160	45	package main;
d020a79a	46
3f2ec160	47	require Test::More;
68938d83	48	my $Total = 29;
a9153838	49	Test::More->import(tests => $Total);
3f2ec160	50
30e302f8	51	my $tb = Test::More->builder;
	52	$tb->use_numbers(0);
	53
b1ddf169	54	my $Filename = quotemeta $0;
b1ddf169	55
d020a79a	56	# Preserve the line numbers.
33459055	57	#line 38
3f2ec160	58	ok( 0, 'failing' );
0257f296	59	err_ok( <<ERR );
b1ddf169	60	# Failed test 'failing'
b7f9bbeb	61	# at $0 line 38.
30e302f8	62	ERR
a9153838	63
	64	#line 40
	65	is( "foo", "bar", 'foo is bar?');
	66	is( undef, '', 'undef is empty string?');
	67	is( undef, 0, 'undef is 0?');
	68	is( '', 0, 'empty string is 0?' );
0257f296	69	err_ok( <<ERR );
b1ddf169	70	# Failed test 'foo is bar?'
b7f9bbeb	71	# at $0 line 40.
3f2ec160	72	# got: 'foo'
3f2ec160	73	# expected: 'bar'
b1ddf169	74	# Failed test 'undef is empty string?'
b7f9bbeb	75	# at $0 line 41.
a9153838	76	# got: undef
a9153838	77	# expected: ''
b1ddf169	78	# Failed test 'undef is 0?'
b7f9bbeb	79	# at $0 line 42.
a9153838	80	# got: undef
a9153838	81	# expected: '0'
b1ddf169	82	# Failed test 'empty string is 0?'
b7f9bbeb	83	# at $0 line 43.
a9153838	84	# got: ''
a9153838	85	# expected: '0'
30e302f8	86	ERR
	87
	88	#line 45
	89	isnt("foo", "foo", 'foo isnt foo?' );
	90	isn't("foo", "foo",'foo isn\'t foo?' );
	91	isnt(undef, undef, 'undef isnt undef?');
0257f296	92	err_ok( <<ERR );
b1ddf169	93	# Failed test 'foo isnt foo?'
b7f9bbeb	94	# at $0 line 45.
a9153838	95	# 'foo'
	96	# ne
	97	# 'foo'
b1ddf169	98	# Failed test 'foo isn\'t foo?'
b7f9bbeb	99	# at $0 line 46.
a9153838	100	# 'foo'
	101	# ne
	102	# 'foo'
b1ddf169	103	# Failed test 'undef isnt undef?'
b7f9bbeb	104	# at $0 line 47.
30e302f8	105	# undef
	106	# ne
	107	# undef
	108	ERR
	109
	110	#line 48
	111	like( "foo", '/that/', 'is foo like that' );
	112	unlike( "foo", '/foo/', 'is foo unlike foo' );
0257f296	113	err_ok( <<ERR );
b1ddf169	114	# Failed test 'is foo like that'
b7f9bbeb	115	# at $0 line 48.
3f2ec160	116	# 'foo'
3f2ec160	117	# doesn't match '/that/'
b1ddf169	118	# Failed test 'is foo unlike foo'
b7f9bbeb	119	# at $0 line 49.
a9153838	120	# 'foo'
a9153838	121	# matches '/foo/'
30e302f8	122	ERR
	123
	124	# Nick Clark found this was a bug. Fixed in 0.40.
b1ddf169	125	# line 60
30e302f8	126	like( "bug", '/(%)/', 'regex with % in it' );
0257f296	127	err_ok( <<ERR );
b1ddf169	128	# Failed test 'regex with % in it'
b7f9bbeb	129	# at $0 line 60.
a9153838	130	# 'bug'
a9153838	131	# doesn't match '/(%)/'
30e302f8	132	ERR
30e302f8	133
b1ddf169	134	#line 67
30e302f8	135	fail('fail()');
0257f296	136	err_ok( <<ERR );
b1ddf169	137	# Failed test 'fail()'
b7f9bbeb	138	# at $0 line 67.
30e302f8	139	ERR
	140
	141	#line 52
	142	can_ok('Mooble::Hooble::Yooble', qw(this that));
	143	can_ok('Mooble::Hooble::Yooble', ());
68938d83	144	can_ok(undef, undef);
0257f296	145	err_ok( <<ERR );
b1ddf169	146	# Failed test 'Mooble::Hooble::Yooble->can(...)'
b7f9bbeb	147	# at $0 line 52.
d020a79a	148	# Mooble::Hooble::Yooble->can('this') failed
d020a79a	149	# Mooble::Hooble::Yooble->can('that') failed
b1ddf169	150	# Failed test 'Mooble::Hooble::Yooble->can(...)'
b7f9bbeb	151	# at $0 line 53.
a9153838	152	# can_ok() called with no methods
68938d83	153	# Failed test '->can(...)'
b7f9bbeb	154	# at $0 line 54.
68938d83	155	# can_ok() called with empty class or reference
30e302f8	156	ERR
	157
	158	#line 55
	159	isa_ok(bless([], "Foo"), "Wibble");
	160	isa_ok(42, "Wibble", "My Wibble");
	161	isa_ok(undef, "Wibble", "Another Wibble");
	162	isa_ok([], "HASH");
0257f296	163	err_ok( <<ERR );
b1ddf169	164	# Failed test 'The object isa Wibble'
b7f9bbeb	165	# at $0 line 55.
6686786d	166	# The object isn't a 'Wibble' it's a 'Foo'
b1ddf169	167	# Failed test 'My Wibble isa Wibble'
b7f9bbeb	168	# at $0 line 56.
33459055	169	# My Wibble isn't a reference
b1ddf169	170	# Failed test 'Another Wibble isa Wibble'
b7f9bbeb	171	# at $0 line 57.
33459055	172	# Another Wibble isn't defined
b1ddf169	173	# Failed test 'The object isa HASH'
b7f9bbeb	174	# at $0 line 58.
6686786d	175	# The object isn't a 'HASH' it's a 'ARRAY'
30e302f8	176	ERR
	177
	178	#line 68
	179	cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
	180	cmp_ok( 42.1, '==', 23, , ' ==' );
	181	cmp_ok( 42, '!=', 42 , ' !=' );
	182	cmp_ok( 1, '&&', 0 , ' &&' );
0257f296	183	err_ok( <<ERR );
b1ddf169	184	# Failed test 'cmp_ok eq'
b7f9bbeb	185	# at $0 line 68.
a9153838	186	# got: 'foo'
a9153838	187	# expected: 'bar'
b1ddf169	188	# Failed test ' =='
b7f9bbeb	189	# at $0 line 69.
a9153838	190	# got: 42.1
a9153838	191	# expected: 23
b1ddf169	192	# Failed test ' !='
b7f9bbeb	193	# at $0 line 70.
a9153838	194	# '42'
	195	# !=
	196	# '42'
b1ddf169	197	# Failed test ' &&'
b7f9bbeb	198	# at $0 line 71.
a9153838	199	# '1'
	200	# &&
	201	# '0'
b1ddf169	202	ERR
	203
	204
	205	# line 196
	206	cmp_ok( 42, 'eq', "foo", ' eq with numbers' );
	207	err_ok( <<ERR );
	208	# Failed test ' eq with numbers'
b7f9bbeb	209	# at $0 line 196.
a9153838	210	# got: '42'
a9153838	211	# expected: 'foo'
30e302f8	212	ERR
30e302f8	213
b1ddf169	214
	215	{
	216	my $warnings;
	217	local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
	218
	219	# line 211
	220	cmp_ok( 42, '==', "foo", ' == with strings' );
	221	err_ok( <<ERR );
	222	# Failed test ' == with strings'
b7f9bbeb	223	# at $0 line 211.
b1ddf169	224	# got: 42
	225	# expected: foo
	226	ERR
	227	My::Test::like $warnings,
	228	qq[/^Argument "foo" isn't numeric in .* at $Filename line 211\\\.\n\$/];
	229
	230	}
	231
	232
30e302f8	233	# generate a $!, it changes its value by context.
	234	-e "wibblehibble";
	235	my $Errno_Number = $!+0;
	236	my $Errno_String = $!.'';
	237	#line 80
	238	cmp_ok( $!, 'eq', '', ' eq with stringified errno' );
	239	cmp_ok( $!, '==', -1, ' eq with numerified errno' );
0257f296	240	err_ok( <<ERR );
b1ddf169	241	# Failed test ' eq with stringified errno'
b7f9bbeb	242	# at $0 line 80.
a9153838	243	# got: '$Errno_String'
a9153838	244	# expected: ''
b1ddf169	245	# Failed test ' eq with numerified errno'
b7f9bbeb	246	# at $0 line 81.
a9153838	247	# got: $Errno_Number
a9153838	248	# expected: -1
3f2ec160	249	ERR
3f2ec160	250
30e302f8	251	#line 84
30e302f8	252	use_ok('Hooble::mooble::yooble');
b1ddf169	253
	254	my $more_err_re = <<ERR;
	255	# Failed test 'use Hooble::mooble::yooble;'
b7f9bbeb	256	# at $Filename line 84\\.
b1ddf169	257	# Tried to use 'Hooble::mooble::yooble'.
	258	# Error: Can't locate Hooble.* in \\\@INC .*
	259	# BEGIN failed--compilation aborted at $Filename line 84.
	260	ERR
	261
	262	My::Test::like($err->read, "/^$more_err_re/");
	263
	264
	265	#line 85
30e302f8	266	require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
b1ddf169	267	$more_err_re = <<ERR;
b1ddf169	268	# Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
b7f9bbeb	269	# at $Filename line 85\\.
b1ddf169	270	# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
	271	# Error: Can't locate ALL.* in \\\@INC .*
	272	ERR
	273
	274	My::Test::like($err->read, "/^$more_err_re/");
	275
30e302f8	276
	277	#line 88
	278	END {
b1ddf169	279	$TB->is_eq($$out, <<OUT, 'failing output');
30e302f8	280	1..$Total
	281	not ok - failing
	282	not ok - foo is bar?
	283	not ok - undef is empty string?
	284	not ok - undef is 0?
	285	not ok - empty string is 0?
	286	not ok - foo isnt foo?
	287	not ok - foo isn't foo?
	288	not ok - undef isnt undef?
	289	not ok - is foo like that
	290	not ok - is foo unlike foo
	291	not ok - regex with % in it
	292	not ok - fail()
	293	not ok - Mooble::Hooble::Yooble->can(...)
	294	not ok - Mooble::Hooble::Yooble->can(...)
68938d83	295	not ok - ->can(...)
30e302f8	296	not ok - The object isa Wibble
	297	not ok - My Wibble isa Wibble
	298	not ok - Another Wibble isa Wibble
	299	not ok - The object isa HASH
	300	not ok - cmp_ok eq
	301	not ok - ==
	302	not ok - !=
	303	not ok - &&
30e302f8	304	not ok - eq with numbers
b1ddf169	305	not ok - == with strings
30e302f8	306	not ok - eq with stringified errno
	307	not ok - eq with numerified errno
	308	not ok - use Hooble::mooble::yooble;
	309	not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
	310	OUT
	311
b1ddf169	312	err_ok( <<ERR );
a9153838	313	# Looks like you failed $Total tests of $Total.
3f2ec160	314	ERR
3f2ec160	315
3f2ec160	316	exit(0);
3f2ec160	317	}