lib/Test/Simple/t/00test_harness_check.t Test::Simple test
lib/Test/Simple/t/bad_plan.t Test::Builder plan() test
lib/Test/Simple/t/bail_out.t Test::Builder BAIL_OUT test
+lib/Test/Simple/t/BEGIN_use_ok.t Test::More test
lib/Test/Simple/t/buffer.t Test::Builder buffering test
lib/Test/Simple/t/Builder.t Test::Builder tests
lib/Test/Simple/t/carp.t Test::Builder test
lib/Test/Simple/t/circular_data.t Test::Simple test
+lib/Test/Simple/t/cmp_ok.t Test::More test
lib/Test/Simple/t/create.t Test::Simple test
lib/Test/Simple/t/curr_test.t Test::Builder->curr_test tests
lib/Test/Simple/t/details.t Test::Builder tests
lib/Test/Simple/t/has_plan2.t Test::More->plan tests
lib/Test/Simple/t/has_plan.t Test::Builder->plan tests
lib/Test/Simple/t/import.t Test::More test, importing functions
+lib/Test/Simple/t/is_deeply_dne_bug.t Test::More test
lib/Test/Simple/t/is_deeply_fail.t Test::More test, is_deeply()
+lib/Test/Simple/t/is_deeply_with_threads.t Test::More test
lib/Test/Simple/t/is_fh.t Test::Builder test, _is_fh()
+lib/Test/Simple/t/lib/Dummy.pm Test::More test module
+b/Test/Simple/t/lib/MyOverload.pm Test::More test module
lib/Test/Simple/t/maybe_regex.t Test::Builder->maybe_regex() tests
lib/Test/Simple/t/missing.t Test::Simple test, missing tests
lib/Test/Simple/t/More.t Test::More test, basic stuff
lib/Test/Simple/t/simple.t Test::Simple test, basic stuff
lib/Test/Simple/t/skipall.t Test::More test, skip all tests
lib/Test/Simple/t/skip.t Test::More test, SKIP tests
-lib/Test/Simple/t/sort_bug.t Test::Simple test
lib/Test/Simple/t/tbt_01basic.t Test::Builder::Tester test
lib/Test/Simple/t/tbt_02fhrestore.t Test::Builder::Tester test
lib/Test/Simple/t/tbt_03die.t Test::Builder::Tester test
lib/Test/Simple/t/threads.t Test::Builder thread-safe checks
lib/Test/Simple/t/thread_taint.t Test::Simple test
lib/Test/Simple/t/todo.t Test::More test, TODO tests
+lib/Test/Simple/t/try.t Test::More test
lib/Test/Simple/t/undef.t Test::More test, undefs don't cause warnings
lib/Test/Simple/t/useing.t Test::More test, compile test
lib/Test/Simple/t/use_ok.t Test::More test, use_ok()
use strict;
use vars qw($VERSION);
-$VERSION = '0.70';
+$VERSION = '0.71';
$VERSION = eval $VERSION; # make the alpha version come out as a number
# Make Test::Builder thread-safe for ithreads.
my $maybe_fh = shift;
return 0 unless defined $maybe_fh;
- return 1 if ref $maybe_fh eq 'GLOB'; # its a glob
- return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob ref
+ return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref
+ return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
return eval { $maybe_fh->isa("IO::Handle") } ||
# 5.5.4's tied() and can() doesn't like getting undef
require Exporter;
@ISA = qw(Exporter);
-$VERSION = '0.68';
+$VERSION = '0.71';
use strict;
use strict;
use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.07";
+$VERSION = "1.08";
use Test::Builder;
use Symbol;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.70';
+$VERSION = '0.71';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
# Various ways to say "ok"
ok($got eq $expected, $test_name);
- is ($got, $exptected, $test_name);
- isnt($got, $expected, $test_name);
+ is ($got, $expected, $test_name);
+ isnt($got, $expected, $test_name);
# Rather than print STDERR "# here's what went wrong\n"
diag("here's what went wrong");
my($pack,$filename,$line) = caller;
- local($@,$!,$SIG{__DIE__}); # isolate eval
+ # Work around a glitch in $@ and eval
+ my $eval_error;
+ {
+ local($@,$!,$SIG{__DIE__}); # isolate eval
- if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
- # probably a version check. Perl needs to see the bare number
- # for it to work with non-Exporter based modules.
- eval <<USE;
+ if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+ # probably a version check. Perl needs to see the bare number
+ # for it to work with non-Exporter based modules.
+ eval <<USE;
package $pack;
use $module $imports[0];
USE
- }
- else {
- eval <<USE;
+ }
+ else {
+ eval <<USE;
package $pack;
use $module \@imports;
USE
+ }
+ $eval_error = $@;
}
- my $ok = $tb->ok( !$@, "use $module;" );
+ my $ok = $tb->ok( !$eval_error, "use $module;" );
unless( $ok ) {
- chomp $@;
+ chomp $eval_error;
$@ =~ s{^BEGIN failed--compilation aborted at .*$}
{BEGIN failed--compilation aborted at $filename line $line.}m;
$tb->diag(<<DIAGNOSTIC);
Tried to use '$module'.
- Error: $@
+ Error: $eval_error
DIAGNOSTIC
}
use vars qw(@Data_Stack %Refs_Seen);
my $DNE = bless [], 'Does::Not::Exist';
+
+sub _dne {
+ ref $_[0] eq ref $DNE;
+}
+
+
sub is_deeply {
my $tb = Test::More->builder;
foreach my $idx (0..$#vals) {
my $val = $vals[$idx];
$vals[$idx] = !defined $val ? 'undef' :
- $val eq $DNE ? "Does not exist" :
- ref $val ? "$val" :
+ _dne($val) ? "Does not exist" :
+ ref $val ? "$val" :
"'$val'";
}
if( defined $e1 xor defined $e2 ) {
$ok = 0;
}
- elsif ( $e1 == $DNE xor $e2 == $DNE ) {
+ elsif ( _dne($e1) xor _dne($e2) ) {
$ok = 0;
}
elsif ( $same_ref and ($e1 eq $e2) ) {
use strict 'vars';
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.70';
+$VERSION = '0.71';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
--- /dev/null
+#!/usr/bin/perl -w
+
+# [rt.cpan.org 28345]
+#
+# A use_ok() inside a BEGIN block lacking a plan would be silently ignored.
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use Test::More;
+
+my $result;
+BEGIN {
+ eval {
+ use_ok("Wibble");
+ };
+ $result = $@;
+}
+
+plan tests => 1;
+like $result, '/^You tried to run a test without a plan/';
}
}
-use Test::More tests => 51;
+use lib 't/lib';
+use Test::More tests => 52;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
$@ = $Err;
$! = $Errno;
-use_ok('Text::Soundex');
+use_ok('Dummy');
+is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' );
require_ok('Test::More');
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->level(0);
+
+sub try_cmp_ok {
+ my($left, $cmp, $right) = @_;
+
+ my %expect;
+ $expect{ok} = eval "\$left $cmp \$right";
+ $expect{error} = $@;
+ $expect{error} =~ s/ at .*\n?//;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my $ok = cmp_ok($left, $cmp, $right);
+ $TB->is_num(!!$ok, !!$expect{ok});
+
+ my $diag = $err->read;
+ if( !$ok and $expect{error} ) {
+ $diag =~ s/^# //mg;
+ $TB->like( $diag, "/\Q$expect{error}\E/" );
+ }
+ elsif( $ok ) {
+ $TB->is_eq( $diag, '' );
+ }
+ else {
+ $TB->ok(1);
+ }
+}
+
+
+use Test::More;
+Test::More->builder->no_ending(1);
+
+my @Tests = (
+ [1, '==', 1],
+ [1, '==', 2],
+ ["a", "eq", "b"],
+ ["a", "eq", "a"],
+ [1, "+", 1],
+ [1, "-", 1],
+);
+
+# These don't work yet.
+if( 0 ) {
+#if( eval { require overload } ) {
+ require MyOverload;
+
+ my $cmp = Overloaded::Compare->new("foo", 42);
+ my $ify = Overloaded::Ify->new("bar", 23);
+
+ push @Tests, (
+ [$cmp, '==', 42],
+ [$cmp, 'eq', "foo"],
+ [$ify, 'eq', "bar"],
+ [$ify, "==", 23],
+ );
+}
+
+plan tests => scalar @Tests;
+$TB->plan(tests => @Tests * 2);
+
+for my $test (@Tests) {
+ try_cmp_ok(@$test);
+}
# at $Filename line 84\\.
# Tried to use 'Hooble::mooble::yooble'.
# Error: Can't locate Hooble.* in \\\@INC .*
-# BEGIN failed--compilation aborted at $Filename line 84.
ERR
My::Test::like($err->read, "/^$more_err_re/");
--- /dev/null
+#!/usr/bin/perl -w
+
+# test for rt.cpan.org 20768
+#
+# There was a bug where the internal "does not exist" object could get
+# confused with an overloaded object.
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use Test::More;
+
+BEGIN {
+ if( !eval "require overload" ) {
+ plan skip_all => "needs overload.pm";
+ }
+ else {
+ plan tests => 2;
+ }
+}
+
+{
+ package Foo;
+
+ use overload
+ 'eq' => \&overload_equiv,
+ '==' => \&overload_equiv;
+
+ sub new {
+ return bless {}, shift;
+ }
+
+ sub overload_equiv {
+ if (ref($_[0]) ne 'Foo' || ref($_[1]) ne 'Foo') {
+ print ref($_[0]), " ", ref($_[1]), "\n";
+ die "Invalid object passed to overload_equiv\n";
+ }
+
+ return 1; # change to 0 ... makes little difference
+ }
+}
+
+my $obj1 = Foo->new();
+my $obj2 = Foo->new();
+
+eval { is_deeply([$obj1, $obj2], [$obj1, $obj2]); };
+is $@, '';
+
#!/usr/bin/perl -w
-# Test to see if we've worked around some wacky sort/threading bug
-# See [rt.cpan.org 6782]
+# Test to see if is_deeply() plays well with threads.
BEGIN {
if( $ENV{PERL_CORE} ) {
}
use Test::More;
-# Passes with $nthreads = 1 and with eq_set().
-# Passes with $nthreads = 2 and with eq_array().
-# Fails with $nthreads = 2 and with eq_set().
-my $Num_Threads = 2;
+my $Num_Threads = 5;
-plan tests => $Num_Threads;
+plan tests => $Num_Threads * 100 + 5;
sub do_one_thread {
my @list2 = @list;
print "# kid $kid before eq_set\n";
- for my $j (1..99) {
- # With eq_set, either crashes or panics
- eq_set(\@list, \@list2);
- eq_array(\@list, \@list2);
+ for my $j (1..100) {
+ is_deeply(\@list, \@list2);
}
print "# kid $kid exit\n";
return 42;
}
use strict;
-use Test::More tests => 10;
+use Test::More tests => 11;
use TieOut;
ok( !Test::Builder->is_fh("foo"), 'string is not a filehandle' );
ok( !Test::Builder->is_fh(undef), 'undef' );
ok( open(FILE, '>foo') );
-END { close FILE; unlink 'foo' }
+END { close FILE; 1 while unlink 'foo' }
ok( Test::Builder->is_fh(*FILE) );
ok( Test::Builder->is_fh(\*FILE) );
unless defined *OUT{IO};
ok( Test::Builder->is_fh(*OUT{IO}) );
}
+
+
+package Lying::isa;
+
+sub isa {
+ my $self = shift;
+ my $parent = shift;
+
+ return 1 if $parent eq 'IO::Handle';
+}
+
+::ok( Test::Builder->is_fh(bless {}, "Lying::isa"));
--- /dev/null
+package Dummy;
+
+$VERSION = '0.01';
+
+1;
\ No newline at end of file
--- /dev/null
+package Overloaded;
+
+sub new {
+ my $class = shift;
+ bless { string => shift, num => shift }, $class;
+}
+
+
+package Overloaded::Compare;
+use vars qw(@ISA);
+@ISA = qw(Overloaded);
+
+# Sometimes objects have only comparison ops overloaded and nothing else.
+# For example, DateTime objects.
+use overload
+ q{eq} => sub { $_[0]->{string} eq $_[1] },
+ q{==} => sub { $_[0]->{num} == $_[1] };
+
+
+
+package Overloaded::Ify;
+use vars qw(@ISA);
+@ISA = qw(Overloaded);
+
+use overload
+ q{""} => sub { $_[0]->{string} },
+ q{0+} => sub { $_[0]->{num} };
+
+1;
\ No newline at end of file
my $result;
my $tmpfile = 'foo.tmp';
my $out = $Test->output($tmpfile);
-END { unlink($tmpfile) }
+END { 1 while unlink($tmpfile) }
ok( defined $out );
--- /dev/null
+#!perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+
+use Test::More 'no_plan';
+
+require Test::Builder;
+my $tb = Test::Builder->new;
+
+local $SIG{__DIE__} = sub { fail("DIE handler called: @_") };
+
+# These should not change;
+local $@ = 42;
+local $! = 23;
+
+is $tb->_try(sub { 2 }), 2;
+is $tb->_try(sub { return '' }), '';
+
+is $tb->_try(sub { die; }), undef;
+
+is_deeply [$tb->_try(sub { die "Foo\n" }, undef)],
+ [undef, "Foo\n"];
+
+is $@, 42;
+cmp_ok $!, '==', 23;
\ No newline at end of file
projects / p5sagit/p5-mst-13.2.git / commitdiff