diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test/More.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Test/More.pm | 324 |
1 files changed, 209 insertions, 115 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test/More.pm b/Master/tlpkg/tlperl/lib/Test/More.pm index c1f5bf1d151..50f3e39b0ea 100644 --- a/Master/tlpkg/tlperl/lib/Test/More.pm +++ b/Master/tlpkg/tlperl/lib/Test/More.pm @@ -17,10 +17,10 @@ sub _carp { return warn @_, " at $file line $line\n"; } -our $VERSION = '0.98'; +our $VERSION = '1.001002'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) -use Test::Builder::Module; +use Test::Builder::Module 0.99; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok use_ok require_ok is isnt like unlike is_deeply @@ -49,7 +49,6 @@ Test::More - yet another framework for writing test scripts # or use Test::More; # see done_testing() - BEGIN { use_ok( 'Some::Module' ); } require_ok( 'Some::Module' ); # Various ways to say "ok" @@ -269,7 +268,7 @@ For example: ok( $exp{9} == 81, 'simple exponential' ); ok( Film->can('db_Main'), 'set_db()' ); ok( $p->tests == 4, 'saw tests' ); - ok( !grep !defined $_, @items, 'items populated' ); + ok( !grep(!defined $_, @items), 'all items defined' ); (Mnemonic: "This is ok.") @@ -318,7 +317,7 @@ are similar to these: ok( $foo ne '', "Got some foo" ); C<undef> will only ever match C<undef>. So you can test a value -agains C<undef> like this: +against C<undef> like this: is($not_defined, undef, "undefined as expected"); @@ -397,7 +396,7 @@ So this: is similar to: - ok( $got =~ /expected/, 'this is like that'); + ok( $got =~ m/expected/, 'this is like that'); (Mnemonic "This is like that".) @@ -440,8 +439,9 @@ sub unlike ($$;$) { cmp_ok( $got, $op, $expected, $test_name ); -Halfway between ok() and is() lies cmp_ok(). This allows you to -compare two arguments using any binary perl operator. +Halfway between C<ok()> and C<is()> lies C<cmp_ok()>. This allows you +to compare two arguments using any binary perl operator. The test +passes if the comparison is true and fails otherwise. # ok( $got eq $expected ); cmp_ok( $got, 'eq', $expected, 'this eq that' ); @@ -577,59 +577,81 @@ you'd like them to be more specific, you can supply an $object_name =cut sub isa_ok ($$;$) { - my( $object, $class, $obj_name ) = @_; + my( $thing, $class, $thing_name ) = @_; my $tb = Test::More->builder; - my $diag; + my $whatami; + if( !defined $thing ) { + $whatami = 'undef'; + } + elsif( ref $thing ) { + $whatami = 'reference'; - if( !defined $object ) { - $obj_name = 'The thing' unless defined $obj_name; - $diag = "$obj_name isn't defined"; + local($@,$!); + require Scalar::Util; + if( Scalar::Util::blessed($thing) ) { + $whatami = 'object'; + } } else { - my $whatami = ref $object ? 'object' : 'class'; - # We can't use UNIVERSAL::isa because we want to honor isa() overrides - my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } ); - if($error) { - if( $error =~ /^Can't call method "isa" on unblessed reference/ ) { - # Its an unblessed reference - $obj_name = 'The reference' unless defined $obj_name; - if( !UNIVERSAL::isa( $object, $class ) ) { - my $ref = ref $object; - $diag = "$obj_name isn't a '$class' it's a '$ref'"; - } - } - elsif( $error =~ /Can't call method "isa" without a package/ ) { - # It's something that can't even be a class - $obj_name = 'The thing' unless defined $obj_name; - $diag = "$obj_name isn't a class or reference"; - } - else { - die <<WHOA; + $whatami = 'class'; + } + + # We can't use UNIVERSAL::isa because we want to honor isa() overrides + my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } ); + + if($error) { + die <<WHOA unless $error =~ /^Can't (locate|call) method "isa"/; WHOA! I tried to call ->isa on your $whatami and got some weird error. Here's the error. $error WHOA - } - } - else { - $obj_name = "The $whatami" unless defined $obj_name; - if( !$rslt ) { - my $ref = ref $object; - $diag = "$obj_name isn't a '$class' it's a '$ref'"; - } - } } - my $name = "$obj_name isa $class"; - my $ok; - if($diag) { - $ok = $tb->ok( 0, $name ); - $tb->diag(" $diag\n"); + # Special case for isa_ok( [], "ARRAY" ) and like + if( $whatami eq 'reference' ) { + $rslt = UNIVERSAL::isa($thing, $class); + } + + my($diag, $name); + if( defined $thing_name ) { + $name = "'$thing_name' isa '$class'"; + $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined"; + } + elsif( $whatami eq 'object' ) { + my $my_class = ref $thing; + $thing_name = qq[An object of class '$my_class']; + $name = "$thing_name isa '$class'"; + $diag = "The object of class '$my_class' isn't a '$class'"; + } + elsif( $whatami eq 'reference' ) { + my $type = ref $thing; + $thing_name = qq[A reference of type '$type']; + $name = "$thing_name isa '$class'"; + $diag = "The reference of type '$type' isn't a '$class'"; + } + elsif( $whatami eq 'undef' ) { + $thing_name = 'undef'; + $name = "$thing_name isa '$class'"; + $diag = "$thing_name isn't defined"; + } + elsif( $whatami eq 'class' ) { + $thing_name = qq[The class (or class-like) '$thing']; + $name = "$thing_name isa '$class'"; + $diag = "$thing_name isn't a '$class'"; } else { + die; + } + + my $ok; + if($rslt) { $ok = $tb->ok( 1, $name ); } + else { + $ok = $tb->ok( 0, $name ); + $tb->diag(" $diag\n"); + } return $ok; } @@ -662,7 +684,6 @@ sub new_ok { my( $class, $args, $object_name ) = @_; $args ||= []; - $object_name = "The object" unless defined $object_name; my $obj; my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } ); @@ -671,7 +692,8 @@ sub new_ok { isa_ok $obj, $class, $object_name; } else { - $tb->ok( 0, "new() died" ); + $class = 'undef' if !defined $class; + $tb->ok( 0, "$class->new() died" ); $tb->diag(" Error was: $error"); } @@ -705,6 +727,7 @@ This would produce. 1..3 ok 1 - First test + # Subtest: An example subtest 1..2 ok 1 - This is a subtest ok 2 - So is this @@ -781,21 +804,101 @@ sub fail (;$) { =head2 Module tests -You usually want to test if the module you're testing loads ok, rather -than just vomiting if its load fails. For such purposes we have -C<use_ok> and C<require_ok>. +Sometimes you want to test if a module, or a list of modules, can +successfully load. For example, you'll often want a first test which +simply loads all the modules in the distribution to make sure they +work before going on to do more complicated testing. + +For such purposes we have C<use_ok> and C<require_ok>. =over 4 +=item B<require_ok> + + require_ok($module); + require_ok($file); + +Tries to C<require> the given $module or $file. If it loads +successfully, the test will pass. Otherwise it fails and displays the +load error. + +C<require_ok> will guess whether the input is a module name or a +filename. + +No exception will be thrown if the load fails. + + # require Some::Module + require_ok "Some::Module"; + + # require "Some/File.pl"; + require_ok "Some/File.pl"; + + # stop testing if any of your modules will not load + for my $module (@module) { + require_ok $module or BAIL_OUT "Can't load $module"; + } + +=cut + +sub require_ok ($) { + my($module) = shift; + my $tb = Test::More->builder; + + my $pack = caller; + + # Try to determine if we've been given a module name or file. + # Module names must be barewords, files not. + $module = qq['$module'] unless _is_module_name($module); + + my $code = <<REQUIRE; +package $pack; +require $module; +1; +REQUIRE + + my( $eval_result, $eval_error ) = _eval($code); + my $ok = $tb->ok( $eval_result, "require $module;" ); + + unless($ok) { + chomp $eval_error; + $tb->diag(<<DIAGNOSTIC); + Tried to require '$module'. + Error: $eval_error +DIAGNOSTIC + + } + + return $ok; +} + +sub _is_module_name { + my $module = shift; + + # Module names start with a letter. + # End with an alphanumeric. + # The rest is an alphanumeric or :: + $module =~ s/\b::\b//g; + + return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0; +} + + =item B<use_ok> BEGIN { use_ok($module); } BEGIN { use_ok($module, @imports); } -These simply use the given $module and test to make sure the load -happened ok. It's recommended that you run use_ok() inside a BEGIN -block so its functions are exported at compile-time and prototypes are -properly honored. +Like C<require_ok>, but it will C<use> the $module in question and +only loads modules, not files. + +If you just want to test a module can be loaded, use C<require_ok>. + +If you just want to load a module in a test, we recommend simply using +C<use> directly. It will cause the test to stop. + +It's recommended that you run use_ok() inside a BEGIN block so its +functions are exported at compile-time and prototypes are properly +honored. If @imports are given, they are passed through to the use. So this: @@ -829,7 +932,6 @@ import anything, use C<require_ok>. BEGIN { require_ok "Foo" } - =cut sub use_ok ($;@) { @@ -838,6 +940,7 @@ sub use_ok ($;@) { my $tb = Test::More->builder; my( $pack, $filename, $line ) = caller; + $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line my $code; if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { @@ -845,6 +948,8 @@ sub use_ok ($;@) { # for it to work with non-Exporter based modules. $code = <<USE; package $pack; + +#line $line $filename use $module $imports[0]; 1; USE @@ -852,6 +957,8 @@ USE else { $code = <<USE; package $pack; + +#line $line $filename use $module \@{\$args[0]}; 1; USE @@ -892,56 +999,6 @@ sub _eval { return( $eval_result, $eval_error ); } -=item B<require_ok> - - require_ok($module); - require_ok($file); - -Like use_ok(), except it requires the $module or $file. - -=cut - -sub require_ok ($) { - my($module) = shift; - my $tb = Test::More->builder; - - my $pack = caller; - - # Try to determine if we've been given a module name or file. - # Module names must be barewords, files not. - $module = qq['$module'] unless _is_module_name($module); - - my $code = <<REQUIRE; -package $pack; -require $module; -1; -REQUIRE - - my( $eval_result, $eval_error ) = _eval($code); - my $ok = $tb->ok( $eval_result, "require $module;" ); - - unless($ok) { - chomp $eval_error; - $tb->diag(<<DIAGNOSTIC); - Tried to require '$module'. - Error: $eval_error -DIAGNOSTIC - - } - - return $ok; -} - -sub _is_module_name { - my $module = shift; - - # Module names start with a letter. - # End with an alphanumeric. - # The rest is an alphanumeric or :: - $module =~ s/\b::\b//g; - - return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0; -} =back @@ -1121,7 +1178,7 @@ You might remember C<ok() or diag()> with the mnemonic C<open() or die()>. B<NOTE> The exact formatting of the diagnostic output is still -changing, but it is guaranteed that whatever you throw at it it won't +changing, but it is guaranteed that whatever you throw at it won't interfere with the test. =item B<note> @@ -1685,14 +1742,45 @@ If you fail more than 254 tests, it will be reported as 254. B<NOTE> This behavior may go away in future versions. -=head1 CAVEATS and NOTES +=head1 COMPATIBILITY + +Test::More works with Perls as old as 5.8.1. + +Thread support is not very reliable before 5.10.1, but that's +because threads are not very reliable before 5.10.1. + +Although Test::More has been a core module in versions of Perl since 5.6.2, Test::More has evolved since then, and not all of the features you're used to will be present in the shipped version of Test::More. If you are writing a module, don't forget to indicate in your package metadata the minimum version of Test::More that you require. For instance, if you want to use C<done_testing()> but want your test script to run on Perl 5.10.0, you will need to explicitly require Test::More > 0.88. + +Key feature milestones include: =over 4 -=item Backwards compatibility +=item subtests + +Subtests were released in Test::More 0.94, which came with Perl 5.12.0. Subtests did not implicitly call C<done_testing()> until 0.96; the first Perl with that fix was Perl 5.14.0 with 0.98. + +=item C<done_testing()> + +This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as part of Test::More 0.92. + +=item C<cmp_ok()> + +Although C<cmp_ok()> was introduced in 0.40, 0.86 fixed an important bug to make it safe for overloaded objects; the fixed first shipped with Perl in 5.10.1 as part of Test::More 0.92. + +=item C<new_ok()> C<note()> and C<explain()> + +These were was released in Test::More 0.82, and first shipped with Perl in 5.10.1 as part of Test::More 0.92. -Test::More works with Perls as old as 5.6.0. +=back + +There is a full version history in the Changes file, and the Test::More versions included as core can be found using L<Module::CoreList>: + + $ corelist -a Test::More + + +=head1 CAVEATS and NOTES +=over 4 =item utf8 / "Wide character in print" @@ -1703,13 +1791,19 @@ Test::More) duplicates STDOUT and STDERR. So any changes to them, including changing their output disciplines, will not be seem by Test::More. -The work around is to change the filehandles used by Test::Builder -directly. +One work around is to apply encodings to STDOUT and STDERR as early +as possible and before Test::More (or any other Test module) loads. + + use open ':std', ':encoding(utf8)'; + use Test::More; + +A more direct work around is to change the filehandles used by +Test::Builder. my $builder = Test::More->builder; - binmode $builder->output, ":utf8"; - binmode $builder->failure_output, ":utf8"; - binmode $builder->todo_output, ":utf8"; + binmode $builder->output, ":encoding(utf8)"; + binmode $builder->failure_output, ":encoding(utf8)"; + binmode $builder->todo_output, ":encoding(utf8)"; =item Overloaded objects |