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