This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Retract #20548 and #20465.
[perl5.git] / lib / Test / Simple / t / More.t
1 #!perl -w
2
3 BEGIN {
4     if( $ENV{PERL_CORE} ) {
5         chdir 't';
6         @INC = '../lib';
7     }
8 }
9
10 use Test::More tests => 41;
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;
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');
30 like("/usr/local/pr0n/", '/^\/usr\/local/',   'regexes with slashes in like' );
31
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
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
42 isa_ok(bless([], "Foo"), "Foo");
43 isa_ok([], 'ARRAY');
44 isa_ok(\42, 'SCALAR');
45
46
47 # can_ok() & isa_ok should call can() & isa() on the given object, not 
48 # just class, in case of custom can()
49 {
50        local *Foo::can;
51        local *Foo::isa;
52        *Foo::can = sub { $_[0]->[0] };
53        *Foo::isa = sub { $_[0]->[0] };
54        my $foo = bless([0], 'Foo');
55        ok( ! $foo->can('bar') );
56        ok( ! $foo->isa('bar') );
57        $foo->[0] = 1;
58        can_ok( $foo, 'blah');
59        isa_ok( $foo, 'blah');
60 }
61
62
63 pass('pass() passed');
64
65 ok( eq_array([qw(this that whatever)], [qw(this that whatever)]),
66     'eq_array with simple arrays' );
67 ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}),
68     'eq_hash with simple hashes' );
69 ok( eq_set([qw(this that whatever)], [qw(that whatever this)]),
70     'eq_set with simple sets' );
71
72 my @complex_array1 = (
73                       [qw(this that whatever)],
74                       {foo => 23, bar => 42},
75                       "moo",
76                       "yarrow",
77                       [qw(498 10 29)],
78                      );
79 my @complex_array2 = (
80                       [qw(this that whatever)],
81                       {foo => 23, bar => 42},
82                       "moo",
83                       "yarrow",
84                       [qw(498 10 29)],
85                      );
86
87 is_deeply( \@complex_array1, \@complex_array2,    'is_deeply with arrays' );
88 ok( eq_array(\@complex_array1, \@complex_array2),
89     'eq_array with complicated arrays' );
90 ok( eq_set(\@complex_array1, \@complex_array2),
91     'eq_set with complicated arrays' );
92
93 my @array1 = (qw(this that whatever),
94               {foo => 23, bar => 42} );
95 my @array2 = (qw(this that whatever),
96               {foo => 24, bar => 42} );
97
98 ok( !eq_array(\@array1, \@array2),
99     'eq_array with slightly different complicated arrays' );
100 ok( !eq_set(\@array1, \@array2),
101     'eq_set with slightly different complicated arrays' );
102
103 my %hash1 = ( foo => 23,
104               bar => [qw(this that whatever)],
105               har => { foo => 24, bar => 42 },
106             );
107 my %hash2 = ( foo => 23,
108               bar => [qw(this that whatever)],
109               har => { foo => 24, bar => 42 },
110             );
111
112 is_deeply( \%hash1, \%hash2,    'is_deeply with complicated hashes' );
113 ok( eq_hash(\%hash1, \%hash2),  'eq_hash with complicated hashes');
114
115 %hash1 = ( foo => 23,
116            bar => [qw(this that whatever)],
117            har => { foo => 24, bar => 42 },
118          );
119 %hash2 = ( foo => 23,
120            bar => [qw(this tha whatever)],
121            har => { foo => 24, bar => 42 },
122          );
123
124 ok( !eq_hash(\%hash1, \%hash2),
125     'eq_hash with slightly different complicated hashes' );
126
127 is( Test::Builder->new, Test::More->builder,    'builder()' );
128
129
130 cmp_ok(42, '==', 42,        'cmp_ok ==');
131 cmp_ok('foo', 'eq', 'foo',  '       eq');
132 cmp_ok(42.5, '<', 42.6,     '       <');
133 cmp_ok(0, '||', 1,          '       ||');
134
135
136 # Piers pointed out sometimes people override isa().
137 {
138     package Wibble;
139     sub isa {
140         my($self, $class) = @_;
141         return 1 if $class eq 'Wibblemeister';
142     }
143     sub new { bless {} }
144 }
145 isa_ok( Wibble->new, 'Wibblemeister' );
146
147
148 # These two tests must remain at the end.
149 is( $@, $Err,               '$@ untouched' );
150 cmp_ok( $!, '==', $Errno,   '$! untouched' );