1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
#!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = qw(../lib ../lib/Test/Simple/t/lib);
}
}
use lib 't/lib';
use Test::More tests => 53;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
my $Errno = 42;
$@ = $Err;
$! = $Errno;
use_ok('Dummy');
is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' );
require_ok('Test::More');
ok( 2 eq 2, 'two is two is two is two' );
is( "foo", "foo", 'foo is foo' );
isnt( "foo", "bar", 'foo isnt bar');
isn't("foo", "bar", 'foo isn\'t bar');
#'#
like("fooble", '/^foo/', 'foo is like fooble');
like("FooBle", '/foo/i', 'foo is like FooBle');
like("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' );
unlike("fbar", '/^bar/', 'unlike bar');
unlike("FooBle", '/foo/', 'foo is unlike FooBle');
unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' );
my @foo = qw(foo bar baz);
unlike(@foo, '/foo/');
can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
pass fail eq_array eq_hash eq_set));
can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
can_ok pass fail eq_array eq_hash eq_set));
isa_ok(bless([], "Foo"), "Foo");
isa_ok([], 'ARRAY');
isa_ok(\42, 'SCALAR');
{
local %Bar::;
local @Foo::ISA = 'Bar';
isa_ok( "Foo", "Bar" );
}
# can_ok() & isa_ok should call can() & isa() on the given object, not
# just class, in case of custom can()
{
local *Foo::can;
local *Foo::isa;
*Foo::can = sub { $_[0]->[0] };
*Foo::isa = sub { $_[0]->[0] };
my $foo = bless([0], 'Foo');
ok( ! $foo->can('bar') );
ok( ! $foo->isa('bar') );
$foo->[0] = 1;
can_ok( $foo, 'blah');
isa_ok( $foo, 'blah');
}
pass('pass() passed');
ok( eq_array([qw(this that whatever)], [qw(this that whatever)]),
'eq_array with simple arrays' );
is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things';
ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}),
'eq_hash with simple hashes' );
is @Test::More::Data_Stack, 0;
ok( eq_set([qw(this that whatever)], [qw(that whatever this)]),
'eq_set with simple sets' );
is @Test::More::Data_Stack, 0;
my @complex_array1 = (
[qw(this that whatever)],
{foo => 23, bar => 42},
"moo",
"yarrow",
[qw(498 10 29)],
);
my @complex_array2 = (
[qw(this that whatever)],
{foo => 23, bar => 42},
"moo",
"yarrow",
[qw(498 10 29)],
);
is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' );
ok( eq_array(\@complex_array1, \@complex_array2),
'eq_array with complicated arrays' );
ok( eq_set(\@complex_array1, \@complex_array2),
'eq_set with complicated arrays' );
my @array1 = (qw(this that whatever),
{foo => 23, bar => 42} );
my @array2 = (qw(this that whatever),
{foo => 24, bar => 42} );
ok( !eq_array(\@array1, \@array2),
'eq_array with slightly different complicated arrays' );
is @Test::More::Data_Stack, 0;
ok( !eq_set(\@array1, \@array2),
'eq_set with slightly different complicated arrays' );
is @Test::More::Data_Stack, 0;
my %hash1 = ( foo => 23,
bar => [qw(this that whatever)],
har => { foo => 24, bar => 42 },
);
my %hash2 = ( foo => 23,
bar => [qw(this that whatever)],
har => { foo => 24, bar => 42 },
);
is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' );
ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes');
%hash1 = ( foo => 23,
bar => [qw(this that whatever)],
har => { foo => 24, bar => 42 },
);
%hash2 = ( foo => 23,
bar => [qw(this tha whatever)],
har => { foo => 24, bar => 42 },
);
ok( !eq_hash(\%hash1, \%hash2),
'eq_hash with slightly different complicated hashes' );
is @Test::More::Data_Stack, 0;
is( Test::Builder->new, Test::More->builder, 'builder()' );
cmp_ok(42, '==', 42, 'cmp_ok ==');
cmp_ok('foo', 'eq', 'foo', ' eq');
cmp_ok(42.5, '<', 42.6, ' <');
cmp_ok(0, '||', 1, ' ||');
# Piers pointed out sometimes people override isa().
{
package Wibble;
sub isa {
my($self, $class) = @_;
return 1 if $class eq 'Wibblemeister';
}
sub new { bless {} }
}
isa_ok( Wibble->new, 'Wibblemeister' );
my $sub = sub {};
is_deeply( $sub, $sub, 'the same function ref' );
use Symbol;
my $glob = gensym;
is_deeply( $glob, $glob, 'the same glob' );
is_deeply( { foo => $sub, bar => [1, $glob] },
{ foo => $sub, bar => [1, $glob] }
);
# These two tests must remain at the end.
is( $@, $Err, '$@ untouched' );
cmp_ok( $!, '==', $Errno, '$! untouched' );
|
