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_require_ok.t Test::More require_ok() testing
lib/Test/Simple/t/BEGIN_use_ok.t Test::More use_ok() testing
lib/Test/Simple/t/buffer.t Test::Builder buffering test
lib/Test/Simple/t/Builder.t Test::Builder tests
$self->_dup_stdhandles unless $^C;
- return undef;
+ return;
}
=back
Very confusing.
ERR
- my($pack, $file, $line) = $self->caller;
-
- my $todo = $self->todo($pack);
+ my $todo = $self->todo();
$self->_unoverload_str(\$todo);
my $out;
my $msg = $todo ? "Failed (TODO)" : "Failed";
$self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
- if( defined $name ) {
- $self->diag(qq[ $msg test '$name'\n]);
- $self->diag(qq[ at $file line $line.\n]);
- }
- else {
- $self->diag(qq[ $msg test at $file line $line.\n]);
- }
+ my(undef, $file, $line) = $self->caller;
+ if( defined $name ) {
+ $self->diag(qq[ $msg test '$name'\n]);
+ $self->diag(qq[ at $file line $line.\n]);
+ }
+ else {
+ $self->diag(qq[ $msg test at $file line $line.\n]);
+ }
}
return $test ? 1 : 0;
my $code = $self->_caller_context;
- # Yes, it has to look like this or 5.4.5 won't see the #line directive.
+ # Yes, it has to look like this or 5.4.5 won't see the #line
+ # directive.
# Don't ask me, man, I just work here.
$test = eval "
$code" . "\$got $type \$expect;";
local($@, $!, $SIG{__DIE__}); # isolate eval
- # Yes, it has to look like this or 5.4.5 won't see the #line directive.
+ # Yes, it has to look like this or 5.4.5 won't see the #line
+ # directive.
# Don't ask me, man, I just work here.
$test = eval "
$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
return $self->{$attribute};
};
- no strict 'refs';
+ no strict 'refs'; ## no critic
*{__PACKAGE__.'::'.$method} = $code;
}
$fh = $file_or_fh;
}
else {
- $fh = do { local *FH };
- open $fh, ">$file_or_fh" or
+ open $fh, ">", $file_or_fh or
$self->croak("Can't open test output log $file_or_fh: $!");
- _autoflush($fh);
+ _autoflush($fh);
}
return $fh;
$pack = $pack || $self->exported_to || $self->caller($Level);
return 0 unless $pack;
- no strict 'refs';
+ no strict 'refs'; ## no critic
return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
: 0;
}
package Test::Builder::Module;
+use strict;
+
use Test::Builder;
require Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
-$VERSION = '0.74';
-
-use strict;
+our $VERSION = '0.75';
# 5.004's Exporter doesn't have export_to_level.
my $_export_to_level = sub {
package Test::Builder::Tester;
use strict;
-use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.11";
+our $VERSION = "1.12";
use Test::Builder;
use Symbol;
###
use Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
-@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
+our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
# _export_to_level and import stolen directly from Test::More. I am
# the king of cargo cult programming ;-)
=cut
-sub test_out(@)
+sub test_out
{
# do we need to do any setup?
_start_testing() unless $testing;
$out->expect(@_)
}
-sub test_err(@)
+sub test_err
{
# do we need to do any setup?
_start_testing() unless $testing;
if (Test::Builder::Tester::color)
{
# get color
- eval "require Term::ANSIColor";
+ eval { require Term::ANSIColor };
unless ($@)
{
- # colours
+ # colours
- my $green = Term::ANSIColor::color("black").
- Term::ANSIColor::color("on_green");
+ my $green = Term::ANSIColor::color("black").
+ Term::ANSIColor::color("on_green");
my $red = Term::ANSIColor::color("black").
Term::ANSIColor::color("on_red");
- my $reset = Term::ANSIColor::color("reset");
+ my $reset = Term::ANSIColor::color("reset");
- # work out where the two strings start to differ
- my $char = 0;
- $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1);
+ # work out where the two strings start to differ
+ my $char = 0;
+ $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1);
- # get the start string and the two end strings
- my $start = $green . substr($wanted, 0, $char);
- my $gotend = $red . substr($got , $char) . $reset;
- my $wantedend = $red . substr($wanted, $char) . $reset;
+ # get the start string and the two end strings
+ my $start = $green . substr($wanted, 0, $char);
+ my $gotend = $red . substr($got , $char) . $reset;
+ my $wantedend = $red . substr($wanted, $char) . $reset;
- # make the start turn green on and off
- $start =~ s/\n/$reset\n$green/g;
+ # make the start turn green on and off
+ $start =~ s/\n/$reset\n$green/g;
- # make the ends turn red on and off
- $gotend =~ s/\n/$reset\n$red/g;
- $wantedend =~ s/\n/$reset\n$red/g;
+ # make the ends turn red on and off
+ $gotend =~ s/\n/$reset\n$red/g;
+ $wantedend =~ s/\n/$reset\n$red/g;
- # rebuild the strings
- $got = $start . $gotend;
- $wanted = $start . $wantedend;
+ # rebuild the strings
+ $got = $start . $gotend;
+ $wanted = $start . $wantedend;
}
}
package Test::More;
-use 5.004;
-
+use 5.006;
use strict;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.74';
+$VERSION = '0.75';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
my($pack,$filename,$line) = caller;
- # 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;
+ my $code;
+ 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.
+ $code = <<USE;
package $pack;
use $module $imports[0];
+1;
USE
- }
- else {
- eval <<USE;
+ }
+ else {
+ $code = <<USE;
package $pack;
-use $module \@imports;
+use $module \@{\$args[0]};
+1;
USE
- }
- $eval_error = $@;
}
- my $ok = $tb->ok( !$eval_error, "use $module;" );
+ my($eval_result, $eval_error) = _eval($code, \@imports);
+ my $ok = $tb->ok( $eval_result, "use $module;" );
+
unless( $ok ) {
chomp $eval_error;
$@ =~ s{^BEGIN failed--compilation aborted at .*$}
return $ok;
}
+
+sub _eval {
+ my($code) = shift;
+ my @args = @_;
+
+ # Work around oddities surrounding resetting of $@ by immediately
+ # storing it.
+ local($@,$!,$SIG{__DIE__}); # isolate eval
+ my $eval_result = eval $code;
+ my $eval_error = $@;
+
+ return($eval_result, $eval_error);
+}
+
=item B<require_ok>
require_ok($module);
# Module names must be barewords, files not.
$module = qq['$module'] unless _is_module_name($module);
- local($!, $@, $SIG{__DIE__}); # isolate eval
- local $SIG{__DIE__};
- eval <<REQUIRE;
+ my $code = <<REQUIRE;
package $pack;
require $module;
+1;
REQUIRE
- my $ok = $tb->ok( !$@, "require $module;" );
+ my($eval_result, $eval_error) = _eval($code);
+ my $ok = $tb->ok( $eval_result, "require $module;" );
unless( $ok ) {
- chomp $@;
+ chomp $eval_error;
$tb->diag(<<DIAGNOSTIC);
Tried to require '$module'.
- Error: $@
+ Error: $eval_error
DIAGNOSTIC
}
=item Backwards compatibility
-Test::More works with Perls as old as 5.004_05.
+Test::More works with Perls as old as 5.6.0.
=item Overloaded objects
use strict 'vars';
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.74';
+$VERSION = '0.75';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use Test::More;
+
+my $result;
+BEGIN {
+ eval {
+ require_ok("Wibble");
+ };
+ $result = $@;
+}
+
+plan tests => 1;
+like $result, '/^You tried to run a test without a plan/';
print "1..0 # Skip: no working threads\n";
exit 0;
}
+
+ unless ( $ENV{AUTHOR_TESTING} ) {
+ print "1..0 # Skip: many perls have broken threads\n";
+ exit 0;
+ }
}
use Test::More;
my $Num_Threads = 5;
-plan tests => $Num_Threads * 100 + 5;
+plan tests => $Num_Threads * 100 + 6;
sub do_one_thread {
my $rc = $t->join();
cmp_ok( $rc, '==', 42, "threads exit status is $rc" );
}
+
+pass("End of test");
use Test::More;
-plan tests => 18;
+plan tests => 19;
$Why = 'Just testing the todo interface.';
"block at $0 line 82\n",
'todo_skip without $how_many warning' );
}
+
+
+{
+ Test::More->builder->exported_to("Wibble");
+ $Wibble::TODO = ''; # shut up used only once warning
+ TODO: {
+ local $Wibble::TODO = $Why;
+ fail("TODO honors exported_to()");
+ }
+}
\ No newline at end of file
projects / p5sagit/p5-mst-13.2.git / commitdiff