1#!perl -w 2 3BEGIN { 4 if( $ENV{PERL_CORE} ) { 5 chdir 't'; 6 @INC = '../lib'; 7 } 8} 9 10use Test::More tests => 41; 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 36can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok 37 pass fail eq_array eq_hash eq_set)); 38can_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 42isa_ok(bless([], "Foo"), "Foo"); 43isa_ok([], 'ARRAY'); 44isa_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 63pass('pass() passed'); 64 65ok( eq_array([qw(this that whatever)], [qw(this that whatever)]), 66 'eq_array with simple arrays' ); 67ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}), 68 'eq_hash with simple hashes' ); 69ok( eq_set([qw(this that whatever)], [qw(that whatever this)]), 70 'eq_set with simple sets' ); 71 72my @complex_array1 = ( 73 [qw(this that whatever)], 74 {foo => 23, bar => 42}, 75 "moo", 76 "yarrow", 77 [qw(498 10 29)], 78 ); 79my @complex_array2 = ( 80 [qw(this that whatever)], 81 {foo => 23, bar => 42}, 82 "moo", 83 "yarrow", 84 [qw(498 10 29)], 85 ); 86 87is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' ); 88ok( eq_array(\@complex_array1, \@complex_array2), 89 'eq_array with complicated arrays' ); 90ok( eq_set(\@complex_array1, \@complex_array2), 91 'eq_set with complicated arrays' ); 92 93my @array1 = (qw(this that whatever), 94 {foo => 23, bar => 42} ); 95my @array2 = (qw(this that whatever), 96 {foo => 24, bar => 42} ); 97 98ok( !eq_array(\@array1, \@array2), 99 'eq_array with slightly different complicated arrays' ); 100ok( !eq_set(\@array1, \@array2), 101 'eq_set with slightly different complicated arrays' ); 102 103my %hash1 = ( foo => 23, 104 bar => [qw(this that whatever)], 105 har => { foo => 24, bar => 42 }, 106 ); 107my %hash2 = ( foo => 23, 108 bar => [qw(this that whatever)], 109 har => { foo => 24, bar => 42 }, 110 ); 111 112is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' ); 113ok( 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 124ok( !eq_hash(\%hash1, \%hash2), 125 'eq_hash with slightly different complicated hashes' ); 126 127is( Test::Builder->new, Test::More->builder, 'builder()' ); 128 129 130cmp_ok(42, '==', 42, 'cmp_ok =='); 131cmp_ok('foo', 'eq', 'foo', ' eq'); 132cmp_ok(42.5, '<', 42.6, ' <'); 133cmp_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} 145isa_ok( Wibble->new, 'Wibblemeister' ); 146 147 148# These two tests must remain at the end. 149is( $@, $Err, '$@ untouched' ); 150cmp_ok( $!, '==', $Errno, '$! untouched' ); 151