Commit | Line | Data |
33459055 |
1 | #!perl -w |
2 | |
3 | BEGIN { |
a9153838 |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = '../lib'; |
7 | } |
33459055 |
8 | } |
9 | |
a9153838 |
10 | use Test::More tests => 37; |
11 | |
12 | # Make sure we don't mess with $@ or $!. Test at bottom. |
13 | my $Err = "this should not be touched"; |
14 | my $Errno = 42; |
15 | $@ = $Err; |
16 | $! = $Errno; |
3f2ec160 |
17 | |
18 | use_ok('Text::Soundex'); |
19 | require_ok('Test::More'); |
20 | |
21 | |
22 | ok( 2 eq 2, 'two is two is two is two' ); |
23 | is( "foo", "foo", 'foo is foo' ); |
24 | isnt( "foo", "bar", 'foo isnt bar'); |
25 | isn't("foo", "bar", 'foo isn\'t bar'); |
26 | |
27 | #'# |
28 | like("fooble", '/^foo/', 'foo is like fooble'); |
29 | like("FooBle", '/foo/i', 'foo is like FooBle'); |
d020a79a |
30 | like("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' ); |
31 | |
a9153838 |
32 | unlike("fbar", '/^bar/', 'unlike bar'); |
33 | unlike("FooBle", '/foo/', 'foo is unlike FooBle'); |
34 | unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' ); |
35 | |
d020a79a |
36 | can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok |
37 | pass fail eq_array eq_hash eq_set)); |
38 | can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip |
39 | can_ok pass fail eq_array eq_hash eq_set)); |
40 | |
41 | isa_ok(bless([], "Foo"), "Foo"); |
a9153838 |
42 | isa_ok([], 'ARRAY'); |
43 | isa_ok(\42, 'SCALAR'); |
d020a79a |
44 | |
3f2ec160 |
45 | |
46 | pass('pass() passed'); |
47 | |
48 | ok( eq_array([qw(this that whatever)], [qw(this that whatever)]), |
49 | 'eq_array with simple arrays' ); |
50 | ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}), |
51 | 'eq_hash with simple hashes' ); |
52 | ok( eq_set([qw(this that whatever)], [qw(that whatever this)]), |
53 | 'eq_set with simple sets' ); |
54 | |
55 | my @complex_array1 = ( |
56 | [qw(this that whatever)], |
57 | {foo => 23, bar => 42}, |
58 | "moo", |
59 | "yarrow", |
60 | [qw(498 10 29)], |
61 | ); |
62 | my @complex_array2 = ( |
63 | [qw(this that whatever)], |
64 | {foo => 23, bar => 42}, |
65 | "moo", |
66 | "yarrow", |
67 | [qw(498 10 29)], |
68 | ); |
69 | |
33459055 |
70 | is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' ); |
3f2ec160 |
71 | ok( eq_array(\@complex_array1, \@complex_array2), |
72 | 'eq_array with complicated arrays' ); |
73 | ok( eq_set(\@complex_array1, \@complex_array2), |
74 | 'eq_set with complicated arrays' ); |
75 | |
76 | my @array1 = (qw(this that whatever), |
77 | {foo => 23, bar => 42} ); |
78 | my @array2 = (qw(this that whatever), |
79 | {foo => 24, bar => 42} ); |
80 | |
81 | ok( !eq_array(\@array1, \@array2), |
82 | 'eq_array with slightly different complicated arrays' ); |
83 | ok( !eq_set(\@array1, \@array2), |
84 | 'eq_set with slightly different complicated arrays' ); |
85 | |
86 | my %hash1 = ( foo => 23, |
87 | bar => [qw(this that whatever)], |
88 | har => { foo => 24, bar => 42 }, |
89 | ); |
90 | my %hash2 = ( foo => 23, |
91 | bar => [qw(this that whatever)], |
92 | har => { foo => 24, bar => 42 }, |
93 | ); |
94 | |
33459055 |
95 | is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' ); |
96 | ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes'); |
3f2ec160 |
97 | |
98 | %hash1 = ( foo => 23, |
99 | bar => [qw(this that whatever)], |
100 | har => { foo => 24, bar => 42 }, |
101 | ); |
102 | %hash2 = ( foo => 23, |
103 | bar => [qw(this tha whatever)], |
104 | har => { foo => 24, bar => 42 }, |
105 | ); |
106 | |
107 | ok( !eq_hash(\%hash1, \%hash2), |
108 | 'eq_hash with slightly different complicated hashes' ); |
a9153838 |
109 | |
110 | is( Test::Builder->new, Test::More->builder, 'builder()' ); |
111 | |
112 | |
113 | cmp_ok(42, '==', 42, 'cmp_ok =='); |
114 | cmp_ok('foo', 'eq', 'foo', ' eq'); |
115 | cmp_ok(42.5, '<', 42.6, ' <'); |
116 | cmp_ok(0, '||', 1, ' ||'); |
117 | |
118 | |
119 | # Piers pointed out sometimes people override isa(). |
120 | { |
121 | package Wibble; |
122 | sub isa { |
123 | my($self, $class) = @_; |
124 | return 1 if $class eq 'Wibblemeister'; |
125 | } |
126 | sub new { bless {} } |
127 | } |
128 | isa_ok( Wibble->new, 'Wibblemeister' ); |
129 | |
130 | |
131 | # These two tests must remain at the end. |
132 | is( $@, $Err, '$@ untouched' ); |
133 | cmp_ok( $!, '==', $Errno, '$! untouched' ); |