lib/Test/Simple/t/bad_plan.t Test::Builder plan() test
lib/Test/Simple/t/buffer.t Test::Builder buffering test
lib/Test/Simple/t/Builder.t Test::Builder tests
+lib/Test/Simple/t/circular_data.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/diag.t Test::More diag() test
lib/Test/Simple/t/eq_set.t Test::Simple test
lib/Test/Simple/t/exit.t Test::Simple test, exit codes
-lib/Test/Simple/t/extra.t Test::Simple test
lib/Test/Simple/t/extra_one.t Test::Simple test
+lib/Test/Simple/t/extra.t Test::Simple test
lib/Test/Simple/t/fail-like.t Test::More test, like() failures
lib/Test/Simple/t/fail-more.t Test::More test, tests failing
-lib/Test/Simple/t/fail.t Test::Simple test, test failures
lib/Test/Simple/t/fail_one.t Test::Simple test
+lib/Test/Simple/t/fail.t Test::Simple test, test failures
lib/Test/Simple/t/filehandles.t Test::Simple test, STDOUT can be played with
lib/Test/Simple/t/fork.t Test::More fork tests
lib/Test/Simple/t/harness_active.t Test::Simple test
lib/Test/Simple/t/no_plan.t Test::Simple test, forgot the plan
lib/Test/Simple/t/ok_obj.t Test::Builder object tests
lib/Test/Simple/t/output.t Test::Builder test, output methods
-lib/Test/Simple/t/overload.t Test::Simple test
+lib/Test/Simple/t/overload_threads.t Test::Simple test
+lib/Test/Simple/t/overload.t Test::Simple test
+lib/Test/Simple/t/plan_bad.t Test::Simple test
lib/Test/Simple/t/plan_is_noplan.t Test::Simple test, no_plan
lib/Test/Simple/t/plan_no_plan.t Test::More test, plan() w/no_plan
+lib/Test/Simple/t/plan_shouldnt_import.t Test::Simple test
lib/Test/Simple/t/plan_skip_all.t Test::More test, plan() w/skip_all
lib/Test/Simple/t/plan.t Test::More test, plan()
+lib/Test/Simple/t/require_ok.t Test::Simple test
lib/Test/Simple/t/reset.t Test::Simple test
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/strays.t Test::Builder stray newline checks
-lib/Test/Simple/t/thread_taint.t Test::Simple 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/undef.t Test::More test, undefs don't cause warnings
lib/Test/Simple/t/useing.t Test::More test, compile test
use strict;
use vars qw($VERSION);
-$VERSION = '0.19_01';
-
-my $IsVMS = $^O eq 'VMS';
+$VERSION = '0.21';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
# Make Test::Builder thread-safe for ithreads.
BEGIN {
# Load threads::shared when threads are turned on
if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
require threads::shared;
- threads::shared->import;
+
+ # Hack around YET ANOTHER threads::shared bug. It would
+ # occassionally forget the contents of the variable when sharing it.
+ # So we first copy the data, then share, then put our copy back.
+ *share = sub (\[$@%]) {
+ my $type = ref $_[0];
+ my $data;
+
+ if( $type eq 'HASH' ) {
+ %$data = %{$_[0]};
+ }
+ elsif( $type eq 'ARRAY' ) {
+ @$data = @{$_[0]};
+ }
+ elsif( $type eq 'SCALAR' ) {
+ $$data = ${$_[0]};
+ }
+ else {
+ die "Unknown type: ".$type;
+ }
+
+ $_[0] = &threads::shared::share($_[0]);
+
+ if( $type eq 'HASH' ) {
+ %{$_[0]} = %$data;
+ }
+ elsif( $type eq 'ARRAY' ) {
+ @{$_[0]} = @$data;
+ }
+ elsif( $type eq 'SCALAR' ) {
+ ${$_[0]} = $$data;
+ }
+ else {
+ die "Unknown type: ".$type;
+ }
+
+ return $_[0];
+ };
}
# 5.8.0's threads::shared is busted when threads are off.
# We emulate it here.
=cut
sub expected_tests {
- my($self, $max) = @_;
+ my $self = shift;
+ my($max) = @_;
+
+ if( @_ ) {
+ die "Number of tests must be a postive integer. You gave it '$max'.\n"
+ unless $max =~ /^\+?\d+$/ and $max > 0;
- if( defined $max ) {
$Expected_Tests = $max;
$Have_Plan = 1;
$Curr_Test++;
# In case $name is a string overloaded object, force it to stringify.
- local($@,$!);
- eval {
- if( defined $name ) {
- require overload;
- if( my $string_meth = overload::Method($name, '""') ) {
- $name = $name->$string_meth();
- }
- }
- };
+ $self->_unoverload(\$name);
$self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
You named your test '$name'. You shouldn't use numbers for your test names.
my($pack, $file, $line) = $self->caller;
my $todo = $self->todo($pack);
+ $self->_unoverload(\$todo);
my $out;
my $result = &share({});
if( defined $name ) {
$name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
$out .= " - $name";
- $result->{name} = "$name";
+ $result->{name} = $name;
}
else {
$result->{name} = '';
}
if( $todo ) {
- my $what_todo = $todo;
- $out .= " # TODO $what_todo";
- $result->{reason} = "$what_todo";
+ $out .= " # TODO $todo";
+ $result->{reason} = $todo;
$result->{type} = 'todo';
}
else {
return $test ? 1 : 0;
}
+
+sub _unoverload {
+ my $self = shift;
+
+ local($@,$!);
+
+ eval { require overload } || return;
+
+ foreach my $thing (@_) {
+ eval {
+ if( defined $$thing ) {
+ if( my $string_meth = overload::Method($$thing, '""') ) {
+ $$thing = $$thing->$string_meth();
+ }
+ }
+ };
+ }
+}
+
+
=item B<is_eq>
$Test->is_eq($got, $expected, $name);
sub skip {
my($self, $why) = @_;
$why ||= '';
+ $self->_unoverload(\$why);
unless( $Have_Plan ) {
require Carp;
$Test->diag(@msgs);
-Prints out the given $message. Normally, it uses the failure_output()
-handle, but if this is for a TODO test, the todo_output() handle is
-used.
+Prints out the given @msgs. Like C<print>, arguments are simply
+appended together.
+
+Normally, it uses the failure_output() handle, but if this is for a
+TODO test, the todo_output() handle is used.
Output will be indented and marked with a # so as not to interfere
with test output. A newline will be put on the end if there isn't one
# Prevent printing headers when compiling (i.e. -c)
return if $^C;
+ # Smash args together like print does.
+ # Convert undef to 'undef' so its readable.
+ my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
+
# Escape each line with a #.
- foreach (@msgs) {
- $_ = 'undef' unless defined;
- s/^/# /gms;
- }
+ $msg =~ s/^/# /gm;
- push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+ # Stick a newline on the end if it needs it.
+ $msg .= "\n" unless $msg =~ /\n\Z/;
local $Level = $Level + 1;
- $self->_print_diag(@msgs);
+ $self->_print_diag($msg);
return 0;
}
# tests are deparsed with B::Deparse
return if $^C;
+ my $msg = join '', @msgs;
+
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->output;
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
- foreach (@msgs) {
- s/\n(.)/\n# $1/sg;
- }
+ $msg =~ s/\n(.)/\n# $1/sg;
- push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+ # Stick a newline on the end if it needs it.
+ $msg .= "\n" unless $msg =~ /\n\Z/;
- print $fh @msgs;
+ print $fh $msg;
}
=head1 COPYRIGHT
-Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
- Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+Copyright 2002, 2004 by chromatic E<lt>chromatic@wgz.orgE<gt> and
+ Michael G Schwern E<lt>schwern@pobox.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
require Exporter;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.50';
+$VERSION = '0.53';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
+
@ISA = qw(Exporter);
@EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
sub plan {
my(@plan) = @_;
- my $caller = caller;
-
- $Test->exported_to($caller);
-
- my @cleaned_plan;
- my @imports = ();
my $idx = 0;
+ my @cleaned_plan;
while( $idx <= $#plan ) {
- if( $plan[$idx] eq 'import' ) {
- @imports = @{$plan[$idx+1]};
- $idx += 2;
- }
- elsif( $plan[$idx] eq 'no_diag' ) {
+ my $item = $plan[$idx];
+
+ if( $item eq 'no_diag' ) {
$Show_Diag = 0;
- $idx++;
}
else {
- push @cleaned_plan, $plan[$idx];
- $idx++;
+ push @cleaned_plan, $item;
}
+
+ $idx++;
}
$Test->plan(@cleaned_plan);
-
- __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
}
sub import {
my($class) = shift;
- goto &plan;
+
+ my $caller = caller;
+
+ $Test->exported_to($caller);
+
+ my $idx = 0;
+ my @plan;
+ my @imports;
+ while( $idx <= $#_ ) {
+ my $item = $_[$idx];
+
+ if( $item eq 'import' ) {
+ push @imports, @{$_[$idx+1]};
+ $idx++;
+ }
+ else {
+ push @plan, $item;
+ }
+
+ $idx++;
+ }
+
+ plan(@plan);
+
+ __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
}
diag(@diagnostic_message);
Prints a diagnostic message which is guaranteed not to interfere with
-test output. Handy for this sort of thing:
+test output. Like C<print> @diagnostic_message is simply concatinated
+together.
+
+Handy for this sort of thing:
ok( grep(/foo/, @users), "There's a foo user" ) or
diag("Since there's no foo, check that /etc/bar is set up right");
=item B<require_ok>
require_ok($module);
+ require_ok($file);
-Like use_ok(), except it requires the $module.
+Like use_ok(), except it requires the $module or $file.
=cut
my $pack = caller;
+ # Try to deterine 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);
+
local($!, $@); # eval sometimes interferes with $!
eval <<REQUIRE;
package $pack;
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;
+ $module =~ /^[a-zA-Z]\w+$/;
+}
+
=back
=head2 Conditional tests
need to see if two arrays are equivalent, for instance. For these
instances, Test::More provides a handful of useful functions.
-B<NOTE> These are NOT well-tested on circular references. Nor am I
-quite sure what will happen with filehandles.
+B<NOTE> I'm not quite sure what will happen with filehandles.
=over 4
=cut
-use vars qw(@Data_Stack);
+use vars qw(@Data_Stack %Refs_Seen);
my $DNE = bless [], 'Does::Not::Exist';
sub is_deeply {
unless( @_ == 2 or @_ == 3 ) {
my($this, $that, $name) = @_;
my $ok;
- if( !ref $this || !ref $that ) {
+ if( !ref $this xor !ref $that ) { # one's a reference, one isn't
+ $ok = 0;
+ }
+ if( !ref $this and !ref $that ) {
$ok = $Test->is_eq($this, $that, $name);
}
else {
local @Data_Stack = ();
+ local %Refs_Seen = ();
if( _deep_check($this, $that) ) {
$ok = $Test->ok(1, $name);
}
=cut
#'#
-sub eq_array {
+sub eq_array {
+ local @Data_Stack;
+ local %Refs_Seen;
+ _eq_array(@_);
+}
+
+sub _eq_array {
my($a1, $a2) = @_;
+
+ if( grep !UNIVERSAL::isa($_, 'ARRAY'), $a1, $a2 ) {
+ warn "eq_array passed a non-array ref";
+ return 0;
+ }
+
return 1 if $a1 eq $a2;
+ if($Refs_Seen{$a1}) {
+ return $Refs_Seen{$a1} eq $a2;
+ }
+ else {
+ $Refs_Seen{$a1} = "$a2";
+ }
+
my $ok = 1;
my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
for (0..$max) {
last unless $ok;
}
+
return $ok;
}
my($e1, $e2) = @_;
my $ok = 0;
- my $eq;
{
# Quiet uninitialized value warnings when comparing undefs.
local $^W = 0;
- if( $e1 eq $e2 ) {
+ $Test->_unoverload(\$e1, \$e2);
+
+ # Either they're both references or both not.
+ my $same_ref = !(!ref $e1 xor !ref $e2);
+
+ if( defined $e1 xor defined $e2 ) {
+ $ok = 0;
+ }
+ elsif ( $e1 == $DNE xor $e2 == $DNE ) {
+ $ok = 0;
+ }
+ elsif ( $same_ref and ($e1 eq $e2) ) {
$ok = 1;
}
else {
if( UNIVERSAL::isa($e1, 'ARRAY') and
UNIVERSAL::isa($e2, 'ARRAY') )
{
- $ok = eq_array($e1, $e2);
+ $ok = _eq_array($e1, $e2);
}
elsif( UNIVERSAL::isa($e1, 'HASH') and
UNIVERSAL::isa($e2, 'HASH') )
{
- $ok = eq_hash($e1, $e2);
+ $ok = _eq_hash($e1, $e2);
}
elsif( UNIVERSAL::isa($e1, 'REF') and
UNIVERSAL::isa($e2, 'REF') )
{
push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
}
else {
push @Data_Stack, { vals => [$e1, $e2] };
=cut
sub eq_hash {
+ local @Data_Stack;
+ local %Refs_Seen;
+ return _eq_hash(@_);
+}
+
+sub _eq_hash {
my($a1, $a2) = @_;
+
+ if( grep !UNIVERSAL::isa($_, 'HASH'), $a1, $a2 ) {
+ warn "eq_hash passed a non-hash ref";
+ return 0;
+ }
+
return 1 if $a1 eq $a2;
+ if( $Refs_Seen{$a1} ) {
+ return $Refs_Seen{$a1} eq $a2;
+ }
+ else {
+ $Refs_Seen{$a1} = "$a2";
+ }
+
my $ok = 1;
my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
foreach my $k (keys %$bigger) {
=cut
-# We must make sure that references are treated neutrally. It really
-# doesn't matter how we sort them, as long as both arrays are sorted
-# with the same algorithm.
-sub _bogus_sort { local $^W = 0; ref $a ? -1 : ref $b ? 1 : $a cmp $b }
-
sub eq_set {
my($a1, $a2) = @_;
return 0 unless @$a1 == @$a2;
# There's faster ways to do this, but this is easiest.
- return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
+ local $^W = 0;
+
+ # We must make sure that references are treated neutrally. It really
+ # doesn't matter how we sort them, as long as both arrays are sorted
+ # with the same algorithm.
+ # Have to inline the sort routine due to a threading/sort bug.
+ # See [rt.cpan.org 6782]
+ return eq_array(
+ [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a1],
+ [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a2]
+ );
}
=back
If you fail more than 254 tests, it will be reported as 254.
-=head1 NOTES
+=head1 CAVEATS and NOTES
-Test::More is B<explicitly> tested all the way back to perl 5.004.
+=over 4
-=head1 BUGS and CAVEATS
+=item Backwards compatibility
+
+Test::More works with Perls as old as 5.004_05.
+
+
+=item Overloaded objects
+
+String overloaded objects are compared B<as strings>. This prevents
+Test::More from piercing an object's interface allowing better blackbox
+testing. So if a function starts returning overloaded objects instead of
+bare strings your tests won't notice the difference. This is good.
+
+However, it does mean that functions like is_deeply() cannot be used to
+test the internals of string overloaded objects. In this case I would
+suggest Test::Deep which contains more flexible testing functions for
+complex data structures.
-=over 4
=item Threads
use Test::More
use threads;
-=item Making your own ok()
-
-If you are trying to extend Test::More, don't. Use Test::Builder
-instead.
-
-=item The eq_* family has some caveats.
=item Test::Harness upgrade
Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
from Joshua Pritikin's Test module and lots of help from Barrie
-Slaymaker, Tony Bowden, blackstar.co.uk, chromatic and the perl-qa gang.
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
+the perl-qa gang.
+
+
+=head1 BUGS
+
+See F<http://rt.cpan.org> to report and view bugs.
=head1 COPYRIGHT
-Copyright 2001, 2002 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+Copyright 2001, 2002, 2004 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use strict 'vars';
use vars qw($VERSION);
-$VERSION = '0.50';
+$VERSION = '0.53';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder;
=head1 COPYRIGHT
-Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+Copyright 2001, 2002, 2004 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
+0.53 Mon Nov 29 04:43:24 EST 2004
+ - Apparently its possible to have Module::Signature installed without
+ it being functional. Fixed the signature test to account for this.
+ (not a real bug)
+
+0.52 Sun Nov 28 21:41:03 EST 2004
+ - plan() now better checks that the given plan is valid.
+ [rt.cpan.org 2597]
+
+0.51_02 Sat Nov 27 01:25:25 EST 2004
+ * is_deeply() and all the eq_* functions now handle circular data
+ structures. [rt.cpan.org 7289]
+ * require_ok() now handles filepaths in addition to modules.
+ - Clarifying Test::More's position on overloaded objects
+ - Fixed a bug introduced in 0.51_01 causing is_deeply() to pierce
+ overloaded objects.
+ - Mentioning rt.cpan.org for reporting bugs.
+
+0.51_01 Fri Nov 26 02:59:30 EST 2004
+ - plan() was accidentally exporting functions [rt.cpan.org 8385]
+ * diag @msgs would insert # between arguments. [rt.cpan.org 8392]
+ * eq_set() could cause problems under threads due to a weird sort bug
+ [rt.cpan.org 6782]
+ * undef no longer equals '' in is_deeply() [rt.cpan.org 6837]
+ * is_deeply() would sometimes compare references as strings.
+ [rt.cpan.org 7031]
+ - eq_array() and eq_hash() could hold onto references if they failed
+ keeping them in memory and preventing DESTROY. [rt.cpan.org 7032]
+ * is_deeply() could confuse [] with a non-existing value
+ [rt.cpan.org 7030]
+ - is_deeply() diagnostics a little off when scalar refs were inside
+ an array or hash ref [rt.cpan.org 7033]
+ - Thanks to Fergal Daly for ferretting out all these long standing
+ is_deeply and eq_* bugs.
+
+0.51 Tue Nov 23 04:51:12 EST 2004
+ - Fixed bug in fail_one.t on Windows (not a real bug).
+ - TODO reasons as overloaded objects now won't blow up under threads.
+ [Autrijus Tang]
+ - skip() in 0.50 tickled yet another bug in threads::shared. Hacked
+ around it.
+
0.50 Sat Nov 20 00:28:44 EST 2004
- * Fixed bug in fail-more test on Windows (not a real bug).
+ - Fixed bug in fail-more test on Windows (not a real bug).
[rt.cpan.org 8022]
- - Change from CVS to SVK. Hopefully this is the last version control
- system change.
+ - Change from CVS to SVK. Hopefully this is the last time I move
+ version control systems.
- Again removing File::Spec dependency (came back in 0.48_02)
- Change from Aegis back to CVS
make
make test
make install
-
-* Copyright
-
-Copyright 2001 by Michael G Schwern <schwern@pobox.com>.
-
-All rights reserved. You can redistribute and/or modify
-this bundle under the same terms as Perl itself.
-
-See <http://www.perl.com/perl/misc/Artistic.html>.
- Test use_ok() with imports better.
-
- Add BAIL_OUT() (little known Test::Harness feature that basically
- declares that the universe has turned out all wrong and the test
- will now stop what it's doing and just go back to bed.)
-
- Add a way to ask "Are we passing so far?". Probably a
- Test::Builder method.
+See https://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Simple plus here's
+a few more I haven't put in RT yet.
Finish (start?) Test::FAQ
Expand the Test::Tutorial
- Restructure the Test::More synopsis.
-
- Decide if the exit code behavior on failure is a useful default
- case.
-
$^C exception control?
Document that everything goes through Test::Builder->ok()
Add test name to diagnostic output
- Put a newline before the first diagnostic failure when in Test::Harness
-
- Trap bare exit() calls.
-
Add diag() to details().
- Add is_passing() method to check if we're passing?
-
Add at_end() callback?
Combine all *output methods into outputs().
#!/usr/bin/perl
-# $File: //member/autrijus/Module-Signature/t/0-signature.t $ $Author: autrijus $
-# $Revision: #5 $ $Change: 7212 $ $DateTime: 2003/07/28 14:21:21 $
use strict;
-use Test::More tests => 1;
+use Test::More;
-SKIP: {
- if (!eval { require Module::Signature; 1 }) {
- skip("Next time around, consider install Module::Signature, ".
- "so you can verify the integrity of this distribution.", 1);
- }
- elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) {
- skip("Cannot connect to the keyserver", 1);
- }
- else {
- ok(Module::Signature::verify() == Module::Signature::SIGNATURE_OK()
- => "Valid signature" );
- }
+if (!eval { require Module::Signature; 1 }) {
+ plan skip_all =>
+ "Next time around, consider installing Module::Signature, ".
+ "so you can verify the integrity of this distribution.";
+}
+elsif ( !-e 'SIGNATURE' ) {
+ plan skip_all => "SIGNATURE not found";
+}
+elsif ( -s 'SIGNATURE' == 0 ) {
+ plan skip_all => "SIGNATURE file empty";
+}
+elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) {
+ plan skip_all => "Cannot connect to the keyserver to check module ".
+ "signature";
}
+else {
+ plan tests => 1;
+}
+
+my $ret = Module::Signature::verify();
+SKIP: {
+ skip "Module::Signature cannot verify", 1
+ if $ret eq Module::Signature::CANNOT_VERIFY();
-__END__
+ cmp_ok $ret, '==', Module::Signature::SIGNATURE_OK(), "Valid signature";
+}
}
}
-use Test::More tests => 42;
+use Test::More tests => 48;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
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)],
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)],
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()' );
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test is_deeply and friends with circular data structures [rt.cpan.org 7289]
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use Test::More tests => 5;
+
+my $a1 = [ 1, 2, 3 ];
+push @$a1, $a1;
+my $a2 = [ 1, 2, 3 ];
+push @$a2, $a2;
+
+is_deeply $a1, $a2;
+ok( eq_array ($a1, $a2) );
+ok( eq_set ($a1, $a2) );
+
+my $h1 = { 1=>1, 2=>2, 3=>3 };
+$h1->{4} = $h1;
+my $h2 = { 1=>1, 2=>2, 3=>3 };
+$h2->{4} = $h2;
+
+is_deeply $h1, $h2;
+ok( eq_hash ($h1, $h2) );
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = '../lib';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
}
}
use strict;
-use Test::More tests => 7;
+use Test::More tests => 5;
my $Test = Test::More->builder;
# now make a filehandle where we can send data
-my $output;
-tie *FAKEOUT, 'FakeOut', \$output;
+use TieOut;
+my $output = tie *FAKEOUT, 'TieOut';
# force diagnostic output to a filehandle, glad I added this to
# Test::Builder :)
-my @lines;
my $ret;
{
local $TODO = 1;
diag("a single line");
- push @lines, $output;
- $output = '';
-
$ret = diag("multiple\n", "lines");
- push @lines, split(/\n/, $output);
}
-is( @lines, 3, 'diag() should send messages to its filehandle' );
-like( $lines[0], '/^#\s+/', ' should add comment mark to all lines' );
-is( $lines[0], "# a single line\n", ' should send exact message' );
-is( $output, "# multiple\n# lines\n", ' should append multi messages');
+is( $output->read, <<'DIAG', 'diag() with todo_output set' );
+# a single line
+# multiple
+# lines
+DIAG
+
ok( !$ret, 'diag returns false' );
{
$Test->failure_output(\*FAKEOUT);
- $output = '';
$ret = diag("# foo");
}
$Test->failure_output(\*STDERR);
-is( $output, "# # foo\n", "diag() adds a # even if there's one already" );
+is( $output->read, "# # foo\n", "diag() adds # even if there's one already" );
ok( !$ret, 'diag returns false' );
-package FakeOut;
-
-sub TIEHANDLE {
- bless( $_[1], $_[0] );
-}
-sub PRINT {
- my $self = shift;
- $$self .= join('', @_);
+# [rt.cpan.org 8392]
+{
+ $Test->failure_output(\*FAKEOUT);
+ diag(qw(one two));
}
+$Test->failure_output(\*STDERR);
+is( $output->read, <<'DIAG' );
+# onetwo
+DIAG
not ok 1
OUT
- My::Test::ok($$err eq <<"ERR") || print $$err;
+ My::Test::ok($$err eq <<ERR) || print $$err;
# Failed test ($0 at line 45)
# Looks like you failed 1 test of 1.
ERR
# Can't use Test.pm, that's a 5.005 thing.
package main;
-print "1..25\n";
+print "1..34\n";
my $test_num = 1;
# Utility testing functions.
+sub ok ($;$) {
+ my($test, $name) = @_;
+ my $ok = '';
+ $ok .= "not " unless $test;
+ $ok .= "ok $test_num";
+ $ok .= " - $name" if defined $name;
+ $ok .= "\n";
+ print $ok;
+ $test_num++;
+
+ return $test;
+}
+
sub is ($$;$) {
my($this, $that, $name) = @_;
my $test = $$this eq $that;
sub like ($$;$) {
my($this, $regex, $name) = @_;
-
+
$regex = qr/$regex/ unless ref $regex;
my $test = $$this =~ $regex;
#line 198
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, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 198)
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 = '';
+is_deeply( [\'a', 'b'], [\'a', 'c'] );
+is( $out, "not ok 20\n", 'scalar refs in an array' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 274)
+# Structures begin differing at:
+# \$got->[1] = 'b'
+# \$expected->[1] = 'c'
+ERR
-#!perl -w
+#!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
unshift @INC, 't/lib';
}
}
-chdir 't';
-
-BEGIN {
- # There was a bug with overloaded objects and threads.
- # See rt.cpan.org 4218
- eval { require threads; 'threads'->import; 1; };
-}
+use strict;
use Test::More;
BEGIN {
plan skip_all => "needs overload.pm";
}
else {
- plan tests => 3;
+ plan tests => 7;
}
}
package Overloaded;
use overload
- q{""} => sub { $_[0]->{string} };
+ q{""} => sub { $_[0]->{string} },
+ q{0} => sub { $_[0]->{num} },
+ fallback => 1;
sub new {
my $class = shift;
- bless { string => shift }, $class;
+ bless { string => shift, num => shift }, $class;
}
package main;
-my $warnings = '';
-local $SIG{__WARN__} = sub { $warnings = join '', @_ };
-my $obj = Overloaded->new('foo');
-ok( 1, $obj );
+my $obj = Overloaded->new('foo', 42);
+isa_ok $obj, 'Overloaded';
-my $undef = Overloaded->new(undef);
-pass( $undef );
+is $obj, 'foo', 'is() with string overloading';
+cmp_ok $obj, 'eq', 'foo', 'cmp_ok() ...';
+cmp_ok $obj, '==', 'foo', 'cmp_ok() with number overloading';
-is( $warnings, '' );
+is_deeply [$obj], ['foo'], 'is_deeply with string overloading';
+ok eq_array([$obj], ['foo']), 'eq_array ...';
+ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...';
--- /dev/null
+#!perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+chdir 't';
+
+BEGIN {
+ # There was a bug with overloaded objects and threads.
+ # See rt.cpan.org 4218
+ eval { require threads; 'threads'->import; 1; };
+}
+
+use Test::More;
+
+BEGIN {
+ if( !eval "require overload" ) {
+ plan skip_all => "needs overload.pm";
+ }
+ else {
+ plan tests => 5;
+ }
+}
+
+
+package Overloaded;
+
+use overload
+ q{""} => sub { $_[0]->{string} };
+
+sub new {
+ my $class = shift;
+ bless { string => shift }, $class;
+}
+
+
+package main;
+
+my $warnings = '';
+local $SIG{__WARN__} = sub { $warnings = join '', @_ };
+
+# overloaded object as name
+my $obj = Overloaded->new('foo');
+ok( 1, $obj );
+
+# overloaded object which returns undef as name
+my $undef = Overloaded->new(undef);
+pass( $undef );
+
+is( $warnings, '' );
+
+
+TODO: {
+ my $obj = Overloaded->new('not really todo, testing overloaded reason');
+ local $TODO = $obj;
+ fail("Just checking todo as an overloaded value");
+}
+
+
+SKIP: {
+ my $obj = Overloaded->new('not really skipped, testing overloaded reason');
+ skip $obj, 1;
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+print "1..7\n";
+
+my $test_num = 1;
+# Utility testing functions.
+sub ok ($;$) {
+ my($test, $name) = @_;
+ my $ok = '';
+ $ok .= "not " unless $test;
+ $ok .= "ok $test_num";
+ $ok .= " - $name" if defined $name;
+ $ok .= "\n";
+ print $ok;
+ $test_num++;
+
+ return $test;
+}
+
+
+sub is ($$;$) {
+ my($this, $that, $name) = @_;
+ my $test = $this eq $that;
+ my $ok = '';
+ $ok .= "not " unless $test;
+ $ok .= "ok $test_num";
+ $ok .= " - $name" if defined $name;
+ $ok .= "\n";
+ print $ok;
+
+ unless( $test ) {
+ print "# got \n$this";
+ print "# expected \n$that";
+ }
+ $test_num++;
+
+ return $test;
+}
+
+
+use Test::More import => ['plan'];
+
+ok !eval { plan tests => 'no_plan'; };
+is $@, "Number of tests must be a postive integer. You gave it 'no_plan'.\n";
+
+my $foo = [];
+my @foo = ($foo, 2, 3);
+ok !eval { plan tests => @foo };
+is $@, "Number of tests must be a postive integer. You gave it '$foo'.\n";
+
+ok !eval { plan tests => 0 };
+ok !eval { plan tests => -1 };
+ok !eval { plan tests => '' };
--- /dev/null
+#!/usr/bin/perl -w
+
+# plan() used to export functions by mistake [rt.cpan.org 8385]
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+
+use Test::More ();
+Test::More::plan(tests => 1);
+
+Test::More::ok( !__PACKAGE__->can('ok'), 'plan should not export' );
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use Test::More tests => 7;
+
+# Symbol and Class::Struct are both non-XS core modules back to 5.004.
+# So they'll always be there.
+require_ok("Symbol");
+ok( $INC{'Symbol.pm'}, "require_ok MODULE" );
+
+require_ok("Class/Struct.pm");
+ok( $INC{'Class/Struct.pm'}, "require_ok FILE" );
+
+# Its more trouble than its worth to try to create these filepaths to test
+# through require_ok() so we cheat and use the internal logic.
+ok !Test::More::_is_module_name('foo:bar');
+ok !Test::More::_is_module_name('foo/bar.thing');
+ok !Test::More::_is_module_name('Foo::Bar::');
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test to see if we've worked around some wacky sort/threading bug
+# See [rt.cpan.org 6782]
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use Config;
+
+BEGIN {
+ require threads if $Config{useithreads};
+}
+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 $nthreads = 2;
+
+if( $Config{useithreads} ) {
+ plan tests => $nthreads;
+}
+else {
+ plan skip_all => 'no threads';
+}
+
+
+sub do_one_thread {
+ my $kid = shift;
+ my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z',
+ 'hello', 's', 'thisisalongname', '1', '2', '3',
+ 'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
+ 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);
+ }
+ print "# kid $kid exit\n";
+ return 42;
+}
+
+my @kids = ();
+for my $i (1..$nthreads) {
+ my $t = threads->new(\&do_one_thread, $i);
+ print "# parent $$: continue\n";
+ push(@kids, $t);
+}
+for my $t (@kids) {
+ print "# parent $$: waiting for join\n";
+ my $rc = $t->join();
+ cmp_ok( $rc, '==', 42, "threads exit status is $rc" );
+}
exit;
}
-plan tests => 15;
+plan tests => 16;
$Why = 'Just testing the todo interface.';
+my $is_todo;
TODO: {
local $TODO = $Why;
fail("Expected failure");
fail("Another expected failure");
-}
+ $is_todo = Test::More->builder->todo;
+}
pass("This is not todo");
+ok( $is_todo, 'TB->todo' );
TODO: {
$$self .= sprintf $fmt, @_;
}
+sub FILENO {}
+
sub read {
my $self = shift;
my $data = $$self;
projects / p5sagit/p5-mst-13.2.git / commitdiff