From: Rafael Garcia-Suarez Date: Thu, 5 May 2005 17:12:38 +0000 (+0000) Subject: Missing files in Test::Simple X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=43fd88df83839fa8c94108794f0e58abbe740e5e;p=p5sagit%2Fp5-mst-13.2.git Missing files in Test::Simple p4raw-id: //depot/perl@24401 --- diff --git a/lib/Test/Simple/t/create.t b/lib/Test/Simple/t/create.t new file mode 100644 index 0000000..7d266d9 --- /dev/null +++ b/lib/Test/Simple/t/create.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl -w + +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More tests => 8; +use Test::Builder; + +my $more_tb = Test::More->builder; +my $new_tb = Test::Builder->create; + +isa_ok $new_tb, 'Test::Builder'; +isa_ok $more_tb, 'Test::Builder'; + +isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object'; + +is $more_tb, Test::More->builder, 'create does not interfere with ->builder'; +is $more_tb, Test::Builder->new, ' does not interfere with ->new'; + +$new_tb->output("some_file"); +END { 1 while unlink "some_file" } + +$new_tb->plan(tests => 1); +$new_tb->ok(1); + +pass("Changing output() of new TB doesn't interfere with singleton"); + +ok open FILE, "some_file"; +is join("", ), <new->no_header(1); +Test::Builder->new->no_ending(1); +local $ENV{HARNESS_ACTIVE} = 0; + + +# Can't use Test.pm, that's a 5.005 thing. +package main; + + +my $TB = Test::Builder->create; +$TB->plan(tests => 67); + +# Utility testing functions. +sub ok ($;$) { + return $TB->ok(@_); +} + +sub is ($$;$) { + my($this, $that, $name) = @_; + + my $ok = $TB->is_eq($$this, $that, $name); + + $$this = ''; + + return $ok; +} + +sub like ($$;$) { + my($this, $regex, $name) = @_; + $regex = qr/$regex/ unless ref $regex; + + my $ok = $TB->like($$this, $regex, $name); + + $$this = ''; + + return $ok; +} + + +require Test::More; +Test::More->import(tests => 11, import => ['is_deeply']); + +my $Filename = quotemeta $0; + +#line 68 +ok !is_deeply('foo', 'bar', 'plain strings'); +is( $out, "not ok 1 - plain strings\n", 'plain strings' ); +is( $err, < 42 }, { this => 43 }, 'hashes with different values'); +is( $out, "not ok 3 - hashes with different values\n", + 'hashes with different values' ); +is( $err, <{this} = '42' +# \$expected->{this} = '43' +ERR + +#line 99 +ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); +is( $out, "not ok 4 - hashes with different keys\n", + 'hashes with different keys' ); +is( $err, <{this} = Does not exist +# \$expected->{this} = '42' +ERR + +#line 110 +ok !is_deeply([1..9], [1..10], 'arrays of different length'); +is( $out, "not ok 5 - arrays of different length\n", + 'arrays of different length' ); +is( $err, <[9] = Does not exist +# \$expected->[9] = '10' +ERR + +#line 121 +ok !is_deeply([undef, undef], [undef], 'arrays of undefs' ); +is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); +is( $err, <[1] = undef +# \$expected->[1] = Does not exist +ERR + +#line 131 +ok !is_deeply({ foo => undef }, {}, 'hashes of undefs' ); +is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); +is( $err, <{foo} = undef +# \$expected->{foo} = Does not exist +ERR + +#line 141 +ok !is_deeply(\42, \23, 'scalar refs'); +is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); +is( $err, < \$a3 }; +# $b2 = { foo => \$b3 }; +# is_deeply([$a1], [$b1], 'deep mixed scalar refs'); + +my $foo = { + this => [1..10], + that => { up => "down", left => "right" }, + }; + +my $bar = { + this => [1..10], + that => { up => "down", left => "right", foo => 42 }, + }; + +#line 198 +ok !is_deeply( $foo, $bar, 'deep structures' ); +ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); +is( $out, "not ok 11 - deep structures\n", 'deep structures' ); +is( $err, <{that}{foo} = Does not exist +# \$expected->{that}{foo} = '42' +ERR + + +#line 221 +my @tests = ([], + [qw(42)], + [qw(42 23), qw(42 23)] + ); + +foreach my $test (@tests) { + my $num_args = @$test; + + my $warning; + local $SIG{__WARN__} = sub { $warning .= join '', @_; }; + ok !is_deeply(@$test); + + like \$warning, + qr/^is_deeply\(\) takes two or three args, you gave $num_args\.\n/; +} + + +#line 240 +# [rt.cpan.org 6837] +ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""'; +ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); + + +#line 258 +# [rt.cpan.org 7031] +my $a = []; +ok !is_deeply($a, $a.''), "don't compare refs like strings"; +ok !is_deeply([$a], [$a.'']), " even deep inside"; + + +#line 265 +# [rt.cpan.org 7030] +ok !is_deeply( {}, {key => []} ), '[] could match non-existent values'; +ok !is_deeply( [], [[]] ); + + +#line 273 +$$err = $$out = ''; +ok !is_deeply( [\'a', 'b'], [\'a', 'c'] ); +is( $out, "not ok 20\n", 'scalar refs in an array' ); +is( $err, <[1] = 'b' +# \$expected->[1] = 'c' +ERR + + +#line 285 +my $ref = \23; +ok !is_deeply( 23, $ref ); +is( $out, "not ok 21\n", 'scalar vs ref' ); +is( $err, <[0] = $array +# \$expected->[0] = $hash +ERR + + + if( eval { require overload } ) { + my $foo = bless [], "Foo"; + my $bar = bless {}, "Bar"; + + { + package Bar; + overload->import(q[""] => sub { "wibble" }); + } + +#line 353 + ok !is_deeply( [$foo], [$bar] ); + is( $out, "not ok 26\n", 'string overloaded refs respected in diag' ); + is( $err, <[0] = $foo +# \$expected->[0] = 'wibble' +ERR + + } + else { + $TB->skip("Needs overload.pm") for 1..3; + } +} diff --git a/t/lib/Test/Simple/sample_tests/exit.plx b/t/lib/Test/Simple/sample_tests/exit.plx new file mode 100644 index 0000000..7f8ff73 --- /dev/null +++ b/t/lib/Test/Simple/sample_tests/exit.plx @@ -0,0 +1,3 @@ +require Test::Builder; + +exit 1;