diff options
Diffstat (limited to 'cpan/Test-Simple/t/More.t')
| -rw-r--r-- | cpan/Test-Simple/t/More.t | 184 |
1 files changed, 184 insertions, 0 deletions
diff --git a/cpan/Test-Simple/t/More.t b/cpan/Test-Simple/t/More.t new file mode 100644 index 0000000000..ce535e26d9 --- /dev/null +++ b/cpan/Test-Simple/t/More.t @@ -0,0 +1,184 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = qw(../lib ../lib/Test/Simple/t/lib); + } +} + +use lib 't/lib'; +use Test::More tests => 54; + +# Make sure we don't mess with $@ or $!. Test at bottom. +my $Err = "this should not be touched"; +my $Errno = 42; +$@ = $Err; +$! = $Errno; + +use_ok('Dummy'); +is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' ); +require_ok('Test::More'); + + +ok( 2 eq 2, 'two is two is two is two' ); +is( "foo", "foo", 'foo is foo' ); +isnt( "foo", "bar", 'foo isnt bar'); +isn't("foo", "bar", 'foo isn\'t bar'); + +#'# +like("fooble", '/^foo/', 'foo is like fooble'); +like("FooBle", '/foo/i', 'foo is like FooBle'); +like("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' ); + +unlike("fbar", '/^bar/', 'unlike bar'); +unlike("FooBle", '/foo/', 'foo is unlike FooBle'); +unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' ); + +my @foo = qw(foo bar baz); +unlike(@foo, '/foo/'); + +can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok + pass fail eq_array eq_hash eq_set)); +can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip + can_ok pass fail eq_array eq_hash eq_set)); + + +isa_ok(bless([], "Foo"), "Foo"); +isa_ok([], 'ARRAY'); +isa_ok(\42, 'SCALAR'); +{ + local %Bar::; + local @Foo::ISA = 'Bar'; + isa_ok( "Foo", "Bar" ); +} + + +# can_ok() & isa_ok should call can() & isa() on the given object, not +# just class, in case of custom can() +{ + local *Foo::can; + local *Foo::isa; + *Foo::can = sub { $_[0]->[0] }; + *Foo::isa = sub { $_[0]->[0] }; + my $foo = bless([0], 'Foo'); + ok( ! $foo->can('bar') ); + ok( ! $foo->isa('bar') ); + $foo->[0] = 1; + can_ok( $foo, 'blah'); + isa_ok( $foo, 'blah'); +} + + +pass('pass() passed'); + +ok( eq_array([qw(this that whatever)], [qw(this that whatever)]), + 'eq_array with simple arrays' ); +is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things'; + +ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}), + 'eq_hash with simple hashes' ); +is @Test::More::Data_Stack, 0; + +ok( eq_set([qw(this that whatever)], [qw(that whatever this)]), + 'eq_set with simple sets' ); +is @Test::More::Data_Stack, 0; + +my @complex_array1 = ( + [qw(this that whatever)], + {foo => 23, bar => 42}, + "moo", + "yarrow", + [qw(498 10 29)], + ); +my @complex_array2 = ( + [qw(this that whatever)], + {foo => 23, bar => 42}, + "moo", + "yarrow", + [qw(498 10 29)], + ); + +is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' ); +ok( eq_array(\@complex_array1, \@complex_array2), + 'eq_array with complicated arrays' ); +ok( eq_set(\@complex_array1, \@complex_array2), + 'eq_set with complicated arrays' ); + +my @array1 = (qw(this that whatever), + {foo => 23, bar => 42} ); +my @array2 = (qw(this that whatever), + {foo => 24, bar => 42} ); + +ok( !eq_array(\@array1, \@array2), + 'eq_array with slightly different complicated arrays' ); +is @Test::More::Data_Stack, 0; + +ok( !eq_set(\@array1, \@array2), + 'eq_set with slightly different complicated arrays' ); +is @Test::More::Data_Stack, 0; + +my %hash1 = ( foo => 23, + bar => [qw(this that whatever)], + har => { foo => 24, bar => 42 }, + ); +my %hash2 = ( foo => 23, + bar => [qw(this that whatever)], + har => { foo => 24, bar => 42 }, + ); + +is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' ); +ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes'); + +%hash1 = ( foo => 23, + bar => [qw(this that whatever)], + har => { foo => 24, bar => 42 }, + ); +%hash2 = ( foo => 23, + bar => [qw(this tha whatever)], + har => { foo => 24, bar => 42 }, + ); + +ok( !eq_hash(\%hash1, \%hash2), + 'eq_hash with slightly different complicated hashes' ); +is @Test::More::Data_Stack, 0; + +is( Test::Builder->new, Test::More->builder, 'builder()' ); + + +cmp_ok(42, '==', 42, 'cmp_ok =='); +cmp_ok('foo', 'eq', 'foo', ' eq'); +cmp_ok(42.5, '<', 42.6, ' <'); +cmp_ok(0, '||', 1, ' ||'); + + +# Piers pointed out sometimes people override isa(). +{ + package Wibble; + sub isa { + my($self, $class) = @_; + return 1 if $class eq 'Wibblemeister'; + } + sub new { bless {} } +} +isa_ok( Wibble->new, 'Wibblemeister' ); + +my $sub = sub {}; +is_deeply( $sub, $sub, 'the same function ref' ); + +use Symbol; +my $glob = gensym; +is_deeply( $glob, $glob, 'the same glob' ); + +is_deeply( { foo => $sub, bar => [1, $glob] }, + { foo => $sub, bar => [1, $glob] } + ); + + +# rt.cpan.org 53469 is_deeply with regexes +is_deeply( qr/a/, qr/a/, "same regex" ); + + +# These two tests must remain at the end. +is( $@, $Err, '$@ untouched' ); +cmp_ok( $!, '==', $Errno, '$! untouched' ); |