4 if( $ENV{PERL_CORE} ) {
6 @INC = qw(../lib ../lib/Test/Simple/t/lib);
11 use Test::More tests => 53;
13 # Make sure we don't mess with $@ or $!. Test at bottom.
14 my $Err = "this should not be touched";
20 is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' );
21 require_ok('Test::More');
24 ok( 2 eq 2, 'two is two is two is two' );
25 is( "foo", "foo", 'foo is foo' );
26 isnt( "foo", "bar", 'foo isnt bar');
27 isn't("foo", "bar", 'foo isn\'t bar');
30 like("fooble", '/^foo/', 'foo is like fooble');
31 like("FooBle", '/foo/i', 'foo is like FooBle');
32 like("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' );
34 unlike("fbar", '/^bar/', 'unlike bar');
35 unlike("FooBle", '/foo/', 'foo is unlike FooBle');
36 unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' );
38 my @foo = qw(foo bar baz);
39 unlike(@foo, '/foo/');
41 can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
42 pass fail eq_array eq_hash eq_set));
43 can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
44 can_ok pass fail eq_array eq_hash eq_set));
47 isa_ok(bless([], "Foo"), "Foo");
49 isa_ok(\42, 'SCALAR');
52 local @Foo::ISA = 'Bar';
53 isa_ok( "Foo", "Bar" );
57 # can_ok() & isa_ok should call can() & isa() on the given object, not
58 # just class, in case of custom can()
62 *Foo::can = sub { $_[0]->[0] };
63 *Foo::isa = sub { $_[0]->[0] };
64 my $foo = bless([0], 'Foo');
65 ok( ! $foo->can('bar') );
66 ok( ! $foo->isa('bar') );
68 can_ok( $foo, 'blah');
69 isa_ok( $foo, 'blah');
73 pass('pass() passed');
75 ok( eq_array([qw(this that whatever)], [qw(this that whatever)]),
76 'eq_array with simple arrays' );
77 is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things';
79 ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}),
80 'eq_hash with simple hashes' );
81 is @Test::More::Data_Stack, 0;
83 ok( eq_set([qw(this that whatever)], [qw(that whatever this)]),
84 'eq_set with simple sets' );
85 is @Test::More::Data_Stack, 0;
87 my @complex_array1 = (
88 [qw(this that whatever)],
89 {foo => 23, bar => 42},
94 my @complex_array2 = (
95 [qw(this that whatever)],
96 {foo => 23, bar => 42},
102 is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' );
103 ok( eq_array(\@complex_array1, \@complex_array2),
104 'eq_array with complicated arrays' );
105 ok( eq_set(\@complex_array1, \@complex_array2),
106 'eq_set with complicated arrays' );
108 my @array1 = (qw(this that whatever),
109 {foo => 23, bar => 42} );
110 my @array2 = (qw(this that whatever),
111 {foo => 24, bar => 42} );
113 ok( !eq_array(\@array1, \@array2),
114 'eq_array with slightly different complicated arrays' );
115 is @Test::More::Data_Stack, 0;
117 ok( !eq_set(\@array1, \@array2),
118 'eq_set with slightly different complicated arrays' );
119 is @Test::More::Data_Stack, 0;
121 my %hash1 = ( foo => 23,
122 bar => [qw(this that whatever)],
123 har => { foo => 24, bar => 42 },
125 my %hash2 = ( foo => 23,
126 bar => [qw(this that whatever)],
127 har => { foo => 24, bar => 42 },
130 is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' );
131 ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes');
133 %hash1 = ( foo => 23,
134 bar => [qw(this that whatever)],
135 har => { foo => 24, bar => 42 },
137 %hash2 = ( foo => 23,
138 bar => [qw(this tha whatever)],
139 har => { foo => 24, bar => 42 },
142 ok( !eq_hash(\%hash1, \%hash2),
143 'eq_hash with slightly different complicated hashes' );
144 is @Test::More::Data_Stack, 0;
146 is( Test::Builder->new, Test::More->builder, 'builder()' );
149 cmp_ok(42, '==', 42, 'cmp_ok ==');
150 cmp_ok('foo', 'eq', 'foo', ' eq');
151 cmp_ok(42.5, '<', 42.6, ' <');
152 cmp_ok(0, '||', 1, ' ||');
155 # Piers pointed out sometimes people override isa().
159 my($self, $class) = @_;
160 return 1 if $class eq 'Wibblemeister';
164 isa_ok( Wibble->new, 'Wibblemeister' );
167 is_deeply( $sub, $sub, 'the same function ref' );
171 is_deeply( $glob, $glob, 'the same glob' );
173 is_deeply( { foo => $sub, bar => [1, $glob] },
174 { foo => $sub, bar => [1, $glob] }
177 # These two tests must remain at the end.
178 is( $@, $Err, '$@ untouched' );
179 cmp_ok( $!, '==', $Errno, '$! untouched' );