1N/A#!perl -w
1N/A
1N/ABEGIN {
1N/A if( $ENV{PERL_CORE} ) {
1N/A chdir 't';
1N/A @INC = '../lib';
1N/A }
1N/A}
1N/A
1N/Ause Test::More tests => 41;
1N/A
1N/A# Make sure we don't mess with $@ or $!. Test at bottom.
1N/Amy $Err = "this should not be touched";
1N/Amy $Errno = 42;
1N/A$@ = $Err;
1N/A$! = $Errno;
1N/A
1N/Ause_ok('Text::Soundex');
1N/Arequire_ok('Test::More');
1N/A
1N/A
1N/Aok( 2 eq 2, 'two is two is two is two' );
1N/Ais( "foo", "foo", 'foo is foo' );
1N/Aisnt( "foo", "bar", 'foo isnt bar');
1N/Aisn't("foo", "bar", 'foo isn\'t bar');
1N/A
1N/A#'#
1N/Alike("fooble", '/^foo/', 'foo is like fooble');
1N/Alike("FooBle", '/foo/i', 'foo is like FooBle');
1N/Alike("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' );
1N/A
1N/Aunlike("fbar", '/^bar/', 'unlike bar');
1N/Aunlike("FooBle", '/foo/', 'foo is unlike FooBle');
1N/Aunlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' );
1N/A
1N/Acan_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
1N/A pass fail eq_array eq_hash eq_set));
1N/Acan_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
1N/A can_ok pass fail eq_array eq_hash eq_set));
1N/A
1N/A
1N/Aisa_ok(bless([], "Foo"), "Foo");
1N/Aisa_ok([], 'ARRAY');
1N/Aisa_ok(\42, 'SCALAR');
1N/A
1N/A
1N/A# can_ok() & isa_ok should call can() & isa() on the given object, not
1N/A# just class, in case of custom can()
1N/A{
1N/A local *Foo::can;
1N/A local *Foo::isa;
1N/A *Foo::can = sub { $_[0]->[0] };
1N/A *Foo::isa = sub { $_[0]->[0] };
1N/A my $foo = bless([0], 'Foo');
1N/A ok( ! $foo->can('bar') );
1N/A ok( ! $foo->isa('bar') );
1N/A $foo->[0] = 1;
1N/A can_ok( $foo, 'blah');
1N/A isa_ok( $foo, 'blah');
1N/A}
1N/A
1N/A
1N/Apass('pass() passed');
1N/A
1N/Aok( eq_array([qw(this that whatever)], [qw(this that whatever)]),
1N/A 'eq_array with simple arrays' );
1N/Aok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}),
1N/A 'eq_hash with simple hashes' );
1N/Aok( eq_set([qw(this that whatever)], [qw(that whatever this)]),
1N/A 'eq_set with simple sets' );
1N/A
1N/Amy @complex_array1 = (
1N/A [qw(this that whatever)],
1N/A {foo => 23, bar => 42},
1N/A "moo",
1N/A "yarrow",
1N/A [qw(498 10 29)],
1N/A );
1N/Amy @complex_array2 = (
1N/A [qw(this that whatever)],
1N/A {foo => 23, bar => 42},
1N/A "moo",
1N/A "yarrow",
1N/A [qw(498 10 29)],
1N/A );
1N/A
1N/Ais_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' );
1N/Aok( eq_array(\@complex_array1, \@complex_array2),
1N/A 'eq_array with complicated arrays' );
1N/Aok( eq_set(\@complex_array1, \@complex_array2),
1N/A 'eq_set with complicated arrays' );
1N/A
1N/Amy @array1 = (qw(this that whatever),
1N/A {foo => 23, bar => 42} );
1N/Amy @array2 = (qw(this that whatever),
1N/A {foo => 24, bar => 42} );
1N/A
1N/Aok( !eq_array(\@array1, \@array2),
1N/A 'eq_array with slightly different complicated arrays' );
1N/Aok( !eq_set(\@array1, \@array2),
1N/A 'eq_set with slightly different complicated arrays' );
1N/A
1N/Amy %hash1 = ( foo => 23,
1N/A bar => [qw(this that whatever)],
1N/A har => { foo => 24, bar => 42 },
1N/A );
1N/Amy %hash2 = ( foo => 23,
1N/A bar => [qw(this that whatever)],
1N/A har => { foo => 24, bar => 42 },
1N/A );
1N/A
1N/Ais_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' );
1N/Aok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes');
1N/A
1N/A%hash1 = ( foo => 23,
1N/A bar => [qw(this that whatever)],
1N/A har => { foo => 24, bar => 42 },
1N/A );
1N/A%hash2 = ( foo => 23,
1N/A bar => [qw(this tha whatever)],
1N/A har => { foo => 24, bar => 42 },
1N/A );
1N/A
1N/Aok( !eq_hash(\%hash1, \%hash2),
1N/A 'eq_hash with slightly different complicated hashes' );
1N/A
1N/Ais( Test::Builder->new, Test::More->builder, 'builder()' );
1N/A
1N/A
1N/Acmp_ok(42, '==', 42, 'cmp_ok ==');
1N/Acmp_ok('foo', 'eq', 'foo', ' eq');
1N/Acmp_ok(42.5, '<', 42.6, ' <');
1N/Acmp_ok(0, '||', 1, ' ||');
1N/A
1N/A
1N/A# Piers pointed out sometimes people override isa().
1N/A{
1N/A package Wibble;
1N/A sub isa {
1N/A my($self, $class) = @_;
1N/A return 1 if $class eq 'Wibblemeister';
1N/A }
1N/A sub new { bless {} }
1N/A}
1N/Aisa_ok( Wibble->new, 'Wibblemeister' );
1N/A
1N/A
1N/A# These two tests must remain at the end.
1N/Ais( $@, $Err, '$@ untouched' );
1N/Acmp_ok( $!, '==', $Errno, '$! untouched' );