cpan/Test-Simple/t/lib/Test/Simple/sample_tests/two_fail.plx
cpan/Test-Simple/t/lib/TieOut.pm
cpan/Test-Simple/t/regression/642_persistent_end.t
+cpan/Test-Simple/t/regression/662-tbt-no-plan.t
cpan/Test-Simple/t/regression/no_name_in_subtest.t
cpan/Test-Simple/t/Test2/acceptance/try_it_done_testing.t
cpan/Test-Simple/t/Test2/acceptance/try_it_fork.t
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
BEGIN {
if( $] < 5.008 ) {
}
}
-use overload();
-
use Scalar::Util qw/blessed reftype weaken/;
use Test2::Util qw/USE_THREADS try get_tid/;
use Test::Builder::TodoDiag;
our $Level = 1;
-our $Test = Test::Builder->new;
-
-# Non-TB tools normally expect 0 added to the level. $Level is normally 1. So
-# we only want the level to change if $Level != 1.
-# TB->ctx compensates for this later.
-Test2::API::test2_add_callback_context_aquire(sub {$_[0]->{level} += $Level - 1});
-
-Test2::API::test2_add_callback_exit(sub { $Test->_ending(@_) });
-
-Test2::API::test2_ipc()->set_no_fatal(1) if USE_THREADS;
+our $Test = $ENV{TB_NO_EARLY_INIT} ? undef : Test::Builder->new;
sub _add_ts_hooks {
my $self = shift;
my $ctx = context();
$Test = $class->create(singleton => 1);
$ctx->release;
+
+ # Non-TB tools normally expect 0 added to the level. $Level is normally 1. So
+ # we only want the level to change if $Level != 1.
+ # TB->ctx compensates for this later.
+ Test2::API::test2_add_callback_context_aquire(sub { $_[0]->{level} += $Level - 1 });
+
+ Test2::API::test2_add_callback_exit(sub { $Test->_ending(@_) });
+
+ Test2::API::test2_ipc()->set_no_fatal(1) if USE_THREADS;
}
return $Test;
}
($err, $child_error) = ($@, $?);
# They might have done 'BEGIN { skip_all => "whatever" }'
- if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/) {
+ if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) {
$ok = undef;
$err = undef;
}
my $ctx = $self->ctx;
+ if (defined $ctx->hub->plan) {
+ warn "Plan already set, no_plan() is a no-op, this will change to a hard failure in the future.";
+ $ctx->release;
+ return;
+ }
+
$ctx->alert("no_plan takes no arguments") if $arg;
$ctx->hub->plan('NO PLAN');
return unless ref $$thing;
return unless blessed($$thing) || scalar $self->_try(sub{ $$thing->isa('UNIVERSAL') });
+ {
+ local ($!, $@);
+ require overload;
+ }
my $string_meth = overload::Method( $$thing, $type ) || return;
$$thing = $$thing->$string_meth();
}
you get it. You might use this instead of C<new()> if you're testing
a Test::Builder based module, but otherwise you probably want C<new>.
-B<NOTE>: the implementation is not complete. C<level>, for example, is
-still shared amongst B<all> Test::Builder objects, even ones created using
-this method. Also, the method name may change in the future.
+B<NOTE>: the implementation is not complete. C<level>, for example, is still
+shared by B<all> Test::Builder objects, even ones created using this method.
+Also, the method name may change in the future.
=item B<subtest>
If you call C<plan()>, don't call any of the other methods below.
-If a child calls "skip_all" in the plan, a C<Test::Builder::Exception> is
-thrown. Trap this error, call C<finalize()> and don't run any more tests on
-the child.
-
- my $child = $Test->child('some child');
- eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) };
- if ( eval { $@->isa('Test::Builder::Exception') } ) {
- $child->finalize;
- return;
- }
- # run your tests
-
-
=item B<expected_tests>
my $max = $Test->expected_tests;
representing a regular expression.
Returns a Perl value which may be used instead of the corresponding
-regular expression, or C<undef> if its argument is not recognised.
+regular expression, or C<undef> if its argument is not recognized.
For example, a version of C<like()>, sans the useful diagnostic messages,
could be written as:
=head1 THREADS
-In perl 5.8.1 and later, Test::Builder is thread-safe. The test
-number is shared amongst all threads. This means if one thread sets
-the test number using C<current_test()> they will all be effected.
+In perl 5.8.1 and later, Test::Builder is thread-safe. The test number is
+shared by all threads. This means if one thread sets the test number using
+C<current_test()> they will all be effected.
While versions earlier than 5.8.1 had threads they contain too many
bugs to support.
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Formatter::TAP';
+BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) }
use Test2::Util::HashBase qw/no_header no_diag/;
use strict;
-use Test::Builder 1.00;
+use Test::Builder;
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
=head1 NAME
$test->plan(@_);
- $class->export_to_level( 1, $class, @imports );
+ local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
+ $class->Exporter::import(@imports);
}
sub _strip_imports {
package Test::Builder::Tester;
use strict;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use Test::Builder 0.99;
+use Test::Builder;
use Symbol;
use Carp;
package Test::Builder::Tester::Color;
use strict;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
require Test::Builder::Tester;
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event::Diag';
+BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) }
sub diagnostics { 0 }
return warn @_, " at $file line $line\n";
}
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use Test::Builder::Module 0.99;
+use Test::Builder::Module;
our @ISA = qw(Test::Builder::Module);
our @EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
my @other = ();
my $idx = 0;
+ my $import;
while( $idx <= $#{$list} ) {
my $item = $list->[$idx];
if( defined $item and $item eq 'no_diag' ) {
$class->builder->no_diag(1);
}
+ elsif( defined $item and $item eq 'import' ) {
+ if ($import) {
+ push @$import, @{$list->[ ++$idx ]};
+ }
+ else {
+ $import = $list->[ ++$idx ];
+ push @other, $item, $import;
+ }
+ }
else {
push @other, $item;
}
@$list = @other;
+ if ($class eq __PACKAGE__ && (!$import || grep $_ eq '$TODO', @$import)) {
+ my $to = $class->builder->exported_to;
+ no strict 'refs';
+ *{"$to\::TODO"} = \our $TODO;
+ if ($import) {
+ @$import = grep $_ ne '$TODO', @$import;
+ }
+ else {
+ push @$list, import => [grep $_ ne '$TODO', @EXPORT];
+ }
+ }
+
return;
}
use strict;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use Test::Builder::Module 0.99;
+use Test::Builder::Module;
our @ISA = qw(Test::Builder::Module);
our @EXPORT = qw(ok);
use vars qw( @ISA @EXPORT );
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
@EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
@ISA = qw( Exporter );
my $colour = '';
my $reset = '';
-if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOUR})
+if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOR})
{
if (eval "require Term::ANSIColor")
{
Note that Test::Builder ensures that any diagnostics end in a \n and
it in earlier versions of Test::Tester it was essential that you have
-the final \n in your expected diagnostics. From version 0.10 onwards,
+the final \n in your expected diagnostics. From version 0.10 onward,
Test::Tester will add the \n if you forgot it. It will not add a \n if
you are expecting no diagnostics. See below for help tracking down
hard to find space and tab related problems.
your diagnostics are wrong when they look perfectly right then the answer is
probably whitespace. From version 0.10 on, Test::Tester surrounds the
expected and got diag values with single quotes to make it easier to spot
-trailing whitesapce. So in this example
+trailing whitespace. So in this example
# Got diag (5 bytes):
# 'abcd '
\{xx}. Tricky characters are those with ASCII code less than 33 or higher
than 126. This makes the output more difficult to read but much easier to
find subtle differences between strings. To turn on this mode either call
-show_space() in your test script or set the TESTTESTERSPACE environment
+C<show_space()> in your test script or set the C<TESTTESTERSPACE> environment
variable to be a true value. The example above would then look like
# Got diag (5 bytes):
=head1 COLOUR
If you prefer to use colour as a means of finding tricky whitespace
-characters then you can set the TESTTESTCOLOUR environment variable to a
+characters then you can set the C<TESTTESTCOLOUR> environment variable to a
comma separated pair of colours, the first for the foreground, the second
for the background. For example "white,red" will print white text on a red
background. This requires the Term::ANSIColor module. You can specify any
colour that would be acceptable to the Term::ANSIColor::color function.
-If you spell colour differently, that's no problem. The TESTTESTERCOLOR
+If you spell colour differently, that's no problem. The C<TESTTESTERCOLOR>
variable also works (if both are set then the British spelling wins out).
=head1 EXPORTED FUNCTIONS
package Test::Tester::Capture;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test::Builder;
package Test::Tester::CaptureRunner;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test::Tester::Capture;
package Test::Tester::Delegate;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use vars '$AUTOLOAD';
package Test::use::ok;
use 5.005;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
__END__
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
1;
=head1 GETTING STARTED
If you are interested in writing tests using new tools then you should look at
-L<Test2::Suite>. L<Test::Suite> is a seperate cpan distribution that contains
+L<Test2::Suite>. L<Test::Suite> is a separate cpan distribution that contains
many tools implemented on Test2.
If you are interested in writing new tools you should take a look at
=head2 Test2::Formatter::
Formatters live under this namespace. L<Test2::Formatter::TAP> is the only
-formatter currently. It is acceptible for third party distributions to create
+formatter currently. It is acceptable for third party distributions to create
new formatters under this namespace.
=head2 Test2::Event::
-Events live under this namespace. It is considered acceptible for third party
+Events live under this namespace. It is considered acceptable for third party
distributions to add new event types in this namespace.
=head2 Test2::Hub::
=head2 Test2::
-The Test2:: namespace is intended for extentions and frameworks. Tools,
-Plugins, etc should not go directly into this namespace. However extentions
+The Test2:: namespace is intended for extensions and frameworks. Tools,
+Plugins, etc should not go directly into this namespace. However extensions
that are used to build tools and plugins may go here.
In short: If the module exports anything that should be run directly by a test
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
my $INST;
test2_formatter_add
test2_formatter_set
};
-use base 'Exporter';
-
-# There is a use-cycle between API and API/Context. Context needs to use some
-# API functions as the package is compiling. Test2::API::context() needs
-# Test2::API::Context to be loaded, but we cannot 'require' the module there as
-# it causes a very noticable performance impact with how often context() is
-# called.
-#
-# This will make sure that Context.pm is loaded the first time this module is
-# imported, then the regular import method is swapped into place.
-sub import {
- require Test2::API::Context unless $INC{'Test2/API/Context.pm'};
-
- {
- no warnings 'redefine';
- *import = \&Exporter::import;
- }
-
- goto &import;
-}
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
my $STACK = $INST->stack;
my $CONTEXTS = $INST->contexts;
delete $CONTEXTS->{$hid};
}
- # Directly bless the object here, calling new is a noticable performance
+ # Directly bless the object here, calling new is a noticeable performance
# hit with how often this needs to be called.
my $trace = bless(
{
'Test2::Util::Trace'
);
- # Directly bless the object here, calling new is a noticable performance
+ # Directly bless the object here, calling new is a noticeable performance
# hit with how often this needs to be called.
my $aborted = 0;
$current = bless(
$err = $@;
# They might have done 'BEGIN { skip_all => "whatever" }'
- if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/) {
+ if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) {
$ok = undef;
$err = undef;
}
return $pass;
}
+# There is a use-cycle between API and API/Context. Context needs to use some
+# API functions as the package is compiling. Test2::API::context() needs
+# Test2::API::Context to be loaded, but we cannot 'require' the module there as
+# it causes a very noticeable performance impact with how often context() is
+# called.
+require Test2::API::Context;
+
1;
__END__
=head1 ***INTERNALS NOTE***
B<The internals of this package are subject to change at any time!> The public
-methods provided will not change in backwords incompatible ways (once there is
+methods provided will not change in backwards-incompatible ways (once there is
a stable release), but the underlying implementation details might.
B<Do not break encapsulation here!>
quickly. You are also provided with tools that help you to test the tools you
write.
-=head1 SYNOPSYS
+=head1 SYNOPSIS
=head2 WRITING A TOOL
return $bool;
}
-See L<Test2::API::Context> for a list of methods avabilable on the context object.
+See L<Test2::API::Context> for a list of methods available on the context object.
=head2 TESTING YOUR TOOLS
=item level => $int
-If you must obtain a context in a sub deper than your entry point you can use
+If you must obtain a context in a sub deeper than your entry point you can use
this to tell it how many EXTRA stack frames to look back. If this option is not
provided the default of C<0> is used.
=item $BUFFERED or \%PARAMS
If this is a simple scalar then it will be treated as a boolean for the
-'buffered' setting. If this is a hash reference then it wil be used as a
+'buffered' setting. If this is a hash reference then it will be used as a
parameters hash. The param hash will be used for hub construction (with the
'buffered' key removed).
=head3 BUFFERED VS UNBUFFERED (OR STREAMED)
Normally all events inside and outside a subtest are sent to the formatter
-immedietly by the hub. Sometimes it is desirable to hold off sending events
+immediately by the hub. Sometimes it is desirable to hold off sending events
within a subtest until the subtest is complete. This usually depends on the
formatter being used.
A formatter can specify by implementing the C<hide_buffered()> method. If this
method returns true then events generated inside a buffered subtest will not be
-sent independantly of the final subtest event.
+sent independently of the final subtest event.
=back
Exports in this section are not commonly needed. These all have the 'test2_'
prefix to help ensure they stand out. You should look at the L</MAIN API
EXPORTS> section before looking here. This section is one where "Great power
-comes with great responsiblity". It is possible to break things badly if you
+comes with great responsibility". It is possible to break things badly if you
are not careful with these.
All exports are optional, you need to list which ones you want at import time:
=item $bool = test2_init_done()
-This will return true if the stack and ipc instances have already been
+This will return true if the stack and IPC instances have already been
initialized. It will return false if they have not. Init happens as late as
-possible, it happens as soon as a tool requests the ipc instance, the
+possible, it happens as soon as a tool requests the IPC instance, the
formatter, or the stack.
=item $bool = test2_load_done()
Add a callback that will be called when Test2 is finished loading. This
means the callback will be run once, the first time a context is obtained.
-If Test2 has already finished loading then the callback will be run immedietly.
+If Test2 has already finished loading then the callback will be run immediately.
=item test2_add_callback_context_acquire(sub { ... })
=item test2_ipc_enable_shm()
-Turn on IPC shm. Only some IPC drivers use this, and most will turn it on
+Turn on IPC SHM. Only some IPC drivers use this, and most will turn it on
themselves.
=item test2_ipc_set_pending($uniq_val)
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test2::Util qw/pkg_to_file/;
upgrade_required
known_broken
};
-use base 'Exporter';
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
sub upgrade_suggested {
return (
specified one then the module will not work. A newer version may work, but is
not tested or verified.
+=back
+
=head1 SOURCE
The source code repository for Test2 can be found at
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Carp qw/confess croak longmess/;
=item $hub = $ctx->hub()
-This will return the L<Test2::Hub> instance the context recognises as
-the current one to which all events should be sent.
+This will return the L<Test2::Hub> instance the context recognizes as the
+current one to which all events should be sent.
=item $dbg = $ctx->trace()
});
B<Note:> The context will actually be cloned, the clone will be used instead of
-the original. This allows the TID, PID, and error vars to be correct without
+the original. This allows the thread id, process id, and error variables to be correct without
modifying the original context.
=item $ctx->restore_error_vars()
This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
way for you to attach meta-data to instances of this class. This is useful for
-tools, plugins, and other extentions.
+tools, plugins, and other extensions.
=head1 SOURCE
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
use Test2::API::Stack();
use Test2::Util::HashBase qw{
- pid tid
+ _pid _tid
no_wait
finalized loaded
ipc stack formatter
context_release_callbacks
};
+sub pid { $_[0]->{+_PID} ||= $$ }
+sub tid { $_[0]->{+_TID} ||= get_tid() }
+
# Wrap around the getters that should call _finalize.
BEGIN {
for my $finalizer (IPC, FORMATTER) {
sub reset {
my $self = shift;
- $self->{+PID} = $$;
- $self->{+TID} = get_tid();
+ delete $self->{+_PID};
+ delete $self->{+_TID};
+
$self->{+CONTEXTS} = {};
$self->{+IPC_DRIVERS} = [];
$self->{+FINALIZED} = $caller;
+ $self->{+_PID} = $$ unless defined $self->{+_PID};
+ $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
unless ($self->{+FORMATTER}) {
my ($formatter, $source);
if ($ENV{T2_FORMATTER}) {
$self->{+FORMATTER} = $formatter;
}
- # Turn on IPC if threads are on, drivers are reigstered, or the Test2::IPC
+ # Turn on IPC if threads are on, drivers are registered, or the Test2::IPC
# module is loaded.
return unless USE_THREADS || $INC{'Test2/IPC.pm'} || @{$self->{+IPC_DRIVERS}};
sub load {
my $self = shift;
unless ($self->{+LOADED}) {
+ $self->{+_PID} = $$ unless defined $self->{+_PID};
+ $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
# This is for https://github.com/Test-More/test-more/issues/16
# and https://rt.perl.org/Public/Bug/Display.html?id=127774
# END blocks run in reverse order. This insures the END block is loaded
sub _ipc_wait {
my $fail = 0;
- while (CAN_FORK) {
- my $pid = CORE::wait();
- my $err = $?;
- last if $pid == -1;
- next unless $err;
- $fail++;
- $err = $err >> 8;
- warn "Process $pid did not exit cleanly (status: $err)\n";
+ if (CAN_FORK) {
+ while (1) {
+ my $pid = CORE::wait();
+ my $err = $?;
+ last if $pid == -1;
+ next unless $err;
+ $fail++;
+ $err = $err >> 8;
+ warn "Process $pid did not exit cleanly (status: $err)\n";
+ }
}
if (USE_THREADS) {
sub DESTROY {
my $self = shift;
- return unless $self->{+PID} == $$;
- return unless $self->{+TID} == get_tid();
+ return unless defined($self->{+_PID}) && $self->{+_PID} == $$;
+ return unless defined($self->{+_TID}) && $self->{+_TID} == get_tid();
shmctl($self->{+IPC_SHM_ID}, IPC::SysV::IPC_RMID(), 0)
if defined $self->{+IPC_SHM_ID};
# Only worry about contexts in this PID
my $trace = $ctx->trace || next;
- next unless $trace->pid == $$;
+ next unless $trace->pid && $trace->pid == $$;
# Do not worry about contexts that have no hub
my $hub = $ctx->hub || next;
$new_exit = 255;
}
- if ($self->{+PID} != $$ or $self->{+TID} != get_tid()) {
+ if (!defined($self->{+_PID}) or !defined($self->{+_TID}) or $self->{+_PID} != $$ or $self->{+_TID} != get_tid()) {
$? = $exit;
return;
}
=item $obj->add_post_load_callback(sub { ... })
Add a post-load callback. If C<load()> has already been called then the callback will
-be immedietly executed. If C<load()> has not been called then the callback will be
+be immediately executed. If C<load()> has not been called then the callback will be
stored and executed later when C<load()> is called.
=item $hashref = $obj->contexts()
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test2::Hub();
=head1 ***INTERNALS NOTE***
B<The internals of this package are subject to change at any time!> The public
-methods provided will not change in backwords incompatible ways, but the
+methods provided will not change in backwards incompatible ways, but the
underlying implementation details might. B<Do not break encapsulation here!>
=head1 DESCRIPTION
instance of the specified class.
Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the
-formatter and ipc instance will be inherited from the current top hub. You can
-set the parameters to C<undef> to avoid having a formatter or ipc instance.
+formatter and IPC instance will be inherited from the current top hub. You can
+set the parameters to C<undef> to avoid having a formatter or IPC instance.
-If there is no top hub, and you do not ask to leave ipc and formatter undef,
+If there is no top hub, and you do not ask to leave IPC and formatter undef,
then a new formatter will be created, and the IPC instance from
L<Test2::API> will be used.
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test2::Util::HashBase qw/trace nested in_subtest subtest_id/;
This is called B<AFTER> your event has been passed to the formatter. This
should normally return undef, only change this if your event should cause the
-test to exit immedietly.
+test to exit immediately.
If you want this event to cause the test to exit you should return the exit
code here. Exit code of 0 means exit success, any other integer means exit with
=item $id = $e->subtest_id
-If the event is a final subtes event, this should contain the subtest ID.
+If the event is a final subtest event, this should contain the subtest ID.
=back
This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
way for you to attach meta-data to instances of this class. This is useful for
-tools, plugins, and other extentions.
+tools, plugins, and other extensions.
=head1 SOURCE
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event';
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase qw{reason};
sub callback {
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event';
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase qw/message/;
sub init {
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event';
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase qw{error};
sub causes_fail { 1 }
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event';
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase qw/message/;
sub init {
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event';
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase qw{
pass effective_pass name todo
};
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event';
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase qw{max directive reason};
use Carp qw/confess/;
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event::Ok';
+BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
use Test2::Util::HashBase qw{reason};
sub init {
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event::Ok';
+BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
use Test2::Util::HashBase qw{subevents buffered subtest_id};
sub init {
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Event';
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
sub global { 1 };
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
my %ADDED;
The C<write> method is a method, so it either gets a class or instance. The 2
arguments are the C<$event> object it should record, and the C<$assert_num>
which is the number of the current assertion (ok), or the last assertion if
-this even is not itself an assertion. The assertion number may be any inyeger 0
-or greator, and may be undefined in some cases.
+this even is not itself an assertion. The assertion number may be any integer 0
+or greater, and may be undefined in some cases.
The C<hide_buffered()> method must return a boolean. This is used to tell
buffered subtests whether or not to send it events as they are being buffered.
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test2::Util::HashBase qw{
use Carp qw/croak/;
-use base 'Test2::Formatter';
+BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) }
my %CONVERTERS = (
'Test2::Event::Ok' => 'event_ok',
# In a verbose harness we indent the diagnostics from the 'Ok' event since
# they will appear inside the subtest braces. This helps readability. In a
- # non-verbose harness we do nto do this because it is less readable.
+ # non-verbose harness we do not do this because it is less readable.
if ($ENV{HARNESS_IS_VERBOSE}) {
# index 0 is the filehandle, index 1 is the message we want to indent.
$_->[1] =~ s/^(.*\S.*)$/ $1/mg for @diag;
=item @out = $TAP->event_other($e, $num)
-Fallback for unregistered event types. It uses the L<Test2::Event> api to
+Fallback for unregistered event types. It uses the L<Test2::Event> API to
convert the event to TAP.
=back
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Carp qw/carp croak confess/;
=head1 DESCRIPTION
The hub is the place where all events get processed and handed off to the
-formatter. The hub also tracks test state, and provides everal hooks into the
+formatter. The hub also tracks test state, and provides several hooks into the
event pipeline.
=head1 COMMON TASKS
=item $sub = $hub->add_context_acquire(sub { ... });
Add a callback that will be called every time someone tries to acquire a
-context. It gets a single argument, a reference the the hash of parameters
+context. It gets a single argument, a reference of the hash of parameters
being used the construct the context. This is your chance to change the
parameters by directly altering the hash.
=item $bool = $hub->check_plan
Check if the plan and counts match, but only if the tests have ended. If tests
-have not unded this will return undef, otherwise it will be a true/false.
+have not ended this will return undef, otherwise it will be a true/false.
=back
This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
way for you to attach meta-data to instances of this class. This is useful for
-tools, plugins, and other extentions.
+tools, plugins, and other extensions.
=head1 SOURCE
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test2::Hub::Interceptor::Terminator();
-use base 'Test2::Hub';
+BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
use Test2::Util::HashBase;
sub inherit {
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
1;
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::Hub';
+BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
use Test2::Util::HashBase qw/nested bailed_out exit_code manual_skip_all id/;
use Test2::Util qw/get_tid/;
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test2::API::Instance;
use Carp qw/confess/;
our @EXPORT_OK = qw/cull/;
-use base 'Exporter';
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
sub import {
goto &Exporter::import unless test2_init_done();
- confess "Cannot add IPC in a child process" if test2_pid() != $$;
- confess "Cannot add IPC in a child thread" if test2_tid() != get_tid();
+ confess "Cannot add IPC in a child process (" . test2_pid() . " vs $$)" if test2_pid() != $$;
+ confess "Cannot add IPC in a child thread (" . test2_tid() . " vs " . get_tid() . ")" if test2_tid() != get_tid();
Test2::API::_set_ipc(_make_ipc());
apply_ipc(test2_stack());
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Carp qw/confess longmess/;
}
# Print the error and call exit. We are not using 'die' cause this is a
-# catastophic error that should never be caught. If we get here it
+# catastrophic error that should never be caught. If we get here it
# means some serious shit has happened in a child process, the only way
# to inform the parent may be to exit false.
=item $bites = $ipc->shm_size()
-Use this to customize the size of the shm space. There are no guarantees about
+Use this to customize the size of the SHM space. There are no guarantees about
what the size will be if you do not implement this.
=back
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
-use base 'Test2::IPC::Driver';
+BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
use Test2::Util::HashBase qw{tempdir event_id tid pid globals};
use File::Temp();
use Storable();
use File::Spec();
+use POSIX();
-use Test2::Util qw/try get_tid pkg_to_file/;
+use Test2::Util qw/try get_tid pkg_to_file IS_WIN32/;
use Test2::API qw/test2_ipc_set_pending/;
sub use_shm { 1 }
my $self = shift;
my ($hid) = @_;
my $tdir = $self->{+TEMPDIR};
- return File::Spec->canonpath("$tdir/HUB-$hid");
+ return File::Spec->catfile($tdir, "HUB-$hid");
}
sub event_file {
my @type = split '::', $type;
my $name = join('-', $hid, $$, get_tid(), $self->{+EVENT_ID}++, @type);
- return File::Spec->canonpath("$tempdir/$name");
+ return File::Spec->catfile($tempdir, $name);
}
sub add_hub {
$self->{+GLOBALS}->{$hid}->{$name}++;
}
+ my ($old, $blocked);
+ unless(IS_WIN32) {
+ my $to_block = POSIX::SigSet->new(
+ POSIX::SIGINT(),
+ POSIX::SIGALRM(),
+ POSIX::SIGHUP(),
+ POSIX::SIGTERM(),
+ POSIX::SIGUSR1(),
+ POSIX::SIGUSR2(),
+ );
+ $old = POSIX::SigSet->new;
+ $blocked = POSIX::sigprocmask(POSIX::SIG_BLOCK(), $to_block, $old);
+ # Silently go on if we failed to log signals, not much we can do.
+ }
+
+ # Write and rename the file.
my ($ok, $err) = try {
Storable::store($e, $file);
rename($file, $ready) or $self->abort("Could not rename file '$file' -> '$ready'");
test2_ipc_set_pending(substr($file, -(shm_size)));
};
+
+ # If our block was successful we want to restore the old mask.
+ POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked;
+
if (!$ok) {
my $src_file = __FILE__;
$err =~ s{ at \Q$src_file\E.*$}{};
next if $global && $self->{+GLOBALS}->{$hid}->{$file}++;
# Untaint the path.
- my $full = File::Spec->canonpath("$tempdir/$file");
+ my $full = File::Spec->catfile($tempdir, $file);
($full) = ($full =~ m/^(.*)$/gs);
my $obj = $self->read_event_file($full);
while(my $file = readdir($dh)) {
next if $file =~ m/^\.+$/;
next if $file =~ m/\.complete$/;
- my $full = File::Spec->canonpath("$tempdir/$file");
+ my $full = File::Spec->catfile($tempdir, $file);
if ($file =~ m/^(GLOBAL|HUB-)/) {
$full =~ m/^(.*)$/;
=head1 DESCRIPTION
This is where gotchas and breakages related to the Test2 upgrade are
-documented. The upgrade causes Test::Builder to defer to Test2 uner the hood.
+documented. The upgrade causes Test::Builder to defer to Test2 under the hood.
This transition is mostly transparent, but there are a few cases that can trip
you up.
order. Many people put conditionals in their code to check the Test::Builder
version number and adapt their code accordingly.
-The Test::Builder2/1.5 projects both died out. Now the conditional code poeple
+The Test::Builder2/1.5 projects both died out. Now the conditional code people
added has become a mine field. A vast majority of modules broken by Test2 fall
into this category.
=head3 The Fix
The fix is to remove all Test::Builder1.5/2 related code. Either use the
-lagacy Test::Builder API, or use Test2 directly.
+legacy Test::Builder API, or use Test2 directly.
=head2 Replacing the Test::Builder singleton
An early change, in fact the change that made Test2 an idea, was a change to
the indentation of the subtest note. IT was decided it would be more readable
-to outdent the subtest note instead of having it inline withthe subtest:
+to outdent the subtest note instead of having it inline with the subtest:
# subtest foo
ok 1 - blah
=item Test::Kit
This actually works fine, but will not install because L<Test::Aggregate> is in
-the dep chain.
+the dependency chain.
See the L<Test::Aggregate> info below for additional information.
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Config qw/%Config/;
CAN_THREAD
CAN_REALLY_FORK
CAN_FORK
+
+ IS_WIN32
};
-use base 'Exporter';
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
+
+BEGIN {
+ *IS_WIN32 = ($^O eq 'MSWin32') ? sub() { 1 } : sub() { 0 };
+}
sub _can_thread {
return 0 unless $] >= 5.008001;
# Threads are broken on perl 5.10.0 built with gcc 4.8+
if ($] == 5.010000 && $Config{'ccname'} eq 'gcc' && $Config{'gccversion'}) {
my @parts = split /\./, $Config{'gccversion'};
- return 0 if $parts[0] >= 4 && $parts[1] >= 8;
+ return 0 if $parts[0] > 4 || ($parts[0] == 4 && $parts[1] >= 8);
}
# Change to a version check if this ever changes
sub _can_fork {
return 1 if $Config{d_fork};
- return 0 unless $^O eq 'MSWin32' || $^O eq 'NetWare';
+ return 0 unless IS_WIN32 || $^O eq 'NetWare';
return 0 unless $Config{useithreads};
return 0 unless $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/;
BEGIN {
no warnings 'once';
- *CAN_REALLY_FORK = $Config{d_fork} ? sub() { 1 } : sub() { 0 };
*CAN_THREAD = _can_thread() ? sub() { 1 } : sub() { 0 };
- *CAN_FORK = _can_fork() ? sub() { 1 } : sub() { 0 };
+}
+my $can_fork;
+sub CAN_FORK () {
+ return $can_fork
+ if defined $can_fork;
+ $can_fork = !!_can_fork();
+ no warnings 'redefine';
+ *CAN_FORK = $can_fork ? sub() { 1 } : sub() { 0 };
+ $can_fork;
+}
+my $can_really_fork;
+sub CAN_REALLY_FORK () {
+ return $can_really_fork
+ if defined $can_really_fork;
+ $can_really_fork = !!$Config{d_fork};
+ no warnings 'redefine';
+ *CAN_REALLY_FORK = $can_really_fork ? sub() { 1 } : sub() { 0 };
+ $can_really_fork;
}
sub _manual_try(&;@) {
# before forking or starting a new thread. So for those systems we use the
# non-local form. When possible though we use the faster 'local' form.
BEGIN {
- if ($^O eq 'MSWin32' && $] < 5.020002) {
+ if (IS_WIN32 && $] < 5.020002) {
*try = \&_manual_try;
}
else {
}
BEGIN {
- if(CAN_THREAD) {
+ if (CAN_THREAD) {
if ($INC{'threads.pm'}) {
# Threads are already loaded, so we do not need to check if they
# are loaded each time
*USE_THREADS = sub() { 1 };
- *get_tid = sub { threads->tid() };
+ *get_tid = sub() { threads->tid() };
}
else {
# :-( Need to check each time to see if they have been loaded.
- *USE_THREADS = sub { $INC{'threads.pm'} ? 1 : 0 };
- *get_tid = sub { $INC{'threads.pm'} ? threads->tid() : 0 };
+ *USE_THREADS = sub() { $INC{'threads.pm'} ? 1 : 0 };
+ *get_tid = sub() { $INC{'threads.pm'} ? threads->tid() : 0 };
}
}
else {
=item CAN_FORK
-True if this system is capable of true or psuedo-fork.
+True if this system is capable of true or pseudo-fork.
=item CAN_REALLY_FORK
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Carp qw/croak/;
sub META_KEY() { '_meta' }
our @EXPORT = qw/meta set_meta get_meta delete_meta/;
-use base 'Exporter';
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
sub set_meta {
my $self = shift;
package, and imports its methods, then third party meta-data has a safe place
to live.
-=head1 SYNOPSYS
+=head1 SYNOPSIS
package My::Object;
use strict;
=item $val = $obj->meta($key, $default)
This will get the value for a specified meta C<$key>. Normally this will return
-C<undef> when there is no value for the C<$key>, however you can specfi a
+C<undef> when there is no value for the C<$key>, however you can specify a
C<$default> value to set when no value is already set.
=item $val = $obj->get_meta($key)
=back
-=head1 META-KEY RESTICTIONS
+=head1 META-KEY RESTRICTIONS
Meta keys must be defined, and must be true when used as a boolean. Keys may
not be references. You are free to stringify a reference C<"$ref"> for use as a
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
require Carp;
$Carp::Internal{+__PACKAGE__} = 1;
-my %ATTRS;
-my %META;
-
-sub _get_inherited_attrs {
- no strict 'refs';
- my @todo = map @{"$_\::ISA"}, @_;
- my %seen;
- my @all;
- while (my $pkg = shift @todo) {
- next if $seen{$pkg}++;
- my $found = $META{$pkg};
- push @all => %$found if $found;
-
- my $isa = \@{"$pkg\::ISA"};
- push @todo => @$isa if @$isa;
+my %ATTR_SUBS;
+
+BEGIN {
+ # these are not strictly equivalent, but for out use we don't care
+ # about order
+ *_isa = ($] >= 5.010 && require mro) ? \&mro::get_linear_isa : sub {
+ no strict 'refs';
+ my @packages = ($_[0]);
+ my %seen;
+ for my $package (@packages) {
+ push @packages, grep !$seen{$_}++, @{"$package\::ISA"};
+ }
+ return \@packages;
}
-
- return \@all;
-}
-
-sub _make_subs {
- my ($str) = @_;
- return $ATTRS{$str} ||= {
- uc($str) => sub() { $str },
- $str => sub { $_[0]->{$str} },
- "set_$str" => sub { $_[0]->{$str} = $_[1] },
- };
}
sub import {
my $class = shift;
my $into = caller;
- my %attrs = map %{_make_subs($_)}, @_;
-
- my @meta = map uc, @_;
- @{$META{$into}}{@meta} = map $attrs{$_}, @meta;
-
+ my $isa = _isa($into);
+ my $attr_subs = $ATTR_SUBS{$into} ||= {};
my %subs = (
- %attrs,
- @{_get_inherited_attrs($into)},
- $into->can('new') ? () : (new => \&_new)
+ ($into->can('new') ? () : (new => \&_new)),
+ (map %{ $ATTR_SUBS{$_}||{} }, @{$isa}[1 .. $#$isa]),
+ (map {
+ my ($sub, $attr) = (uc $_, $_);
+ $sub => ($attr_subs->{$sub} = sub() { $attr }),
+ $attr => sub { $_[0]->{$attr} },
+ "set_$attr" => sub { $_[0]->{$attr} = $_[1] },
+ } @_),
);
no strict 'refs';
will give you a C<new()> method, as well as generating accessors you request.
Generated accessors will be getters, C<set_ACCESSOR> setters will also be
generated for you. You also get constants for each accessor (all caps) which
-return the key into the hash for that accessor. Single inheritence is also
+return the key into the hash for that accessor. Single inheritance is also
supported.
=head1 METHODS
Create a new instance using key/value pairs.
HashBase will not export C<new()> if there is already a C<new()> method in your
-packages inheritence chain.
+packages inheritance chain.
B<If you do not want this method you can define your own> you just have to
declare it before loading L<Test2::Util::HashBase>.
use strict;
use warnings;
-our $VERSION = '1.302015';
+our $VERSION = '1.302022';
use Test2::Util qw/get_tid/;
=item $str = $trace->debug
Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set
-then its value wil be returned instead.
+then its value will be returned instead.
=item $trace->alert($MESSAGE)
package ok;
-$ok::VERSION = '1.302015';
+$ok::VERSION = '1.302022';
use strict;
use Test::More ();
# they're already loaded. This avoids recompilation warnings.
local @INC = @INC;
unshift @INC, ".";
- ok eval { require($file); 1 } or diag "require $file failed.\n$@";
+ my @warnings;
+ ok eval {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ require($file);
+ 1
+ } or diag "require $file failed.", "\n", @warnings, "\n", $@;
SKIP: {
skip "Test::Pod not installed", 1 unless $Has_Test_Pod;
use strict;
use warnings;
+use Test2::Util qw/CAN_THREAD/;
BEGIN {
- my $skip = !eval { require threads; 1 };
- if ($skip) {
+ unless(CAN_THREAD) {
require Test::More;
- Test::More::plan(skip_all => 'no threads');
+ Test::More->import(skip_all => "threads are not supported");
}
}
-
use threads;
use Test::More;
# argh! now we need to test the thing we're testing. Basically we need
# to pretty much reimplement the whole code again. This is very
-# annoying but can't be avoided. And onwards with the cut and paste
+# annoying but can't be avoided. And onward with the cut and paste
# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING
# argh! now we need to test the thing we're testing. Basically we need
# to pretty much reimplement the whole code again. This is very
-# annoying but can't be avoided. And onwards with the cut and paste
+# annoying but can't be avoided. And onward with the cut and paste
# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING
test2_stack->top->unfilter($filter);
ok(1, "Third");
-diag "should be a diag";
done_testing;
is_deeply(
$one,
{
- pid => $$,
- tid => get_tid(),
contexts => {},
finalized => undef,
is_deeply(
$one,
{
- pid => $$,
- tid => get_tid(),
contexts => {},
ipc_polling => undef,
{
$one->reset();
- $one->set_tid(1);
+ $one->set__tid(1);
local $? = 0;
$one->set_exit;
is($?, 0, "no errors on exit");
{
$one->reset();
+ $one->load();
$one->stack->top->set_failed(2);
local $? = 0;
$one->set_exit;
{
$one->reset();
+ $one->load();
local $? = 500;
$one->set_exit;
is($?, 255, "set exit code to a sane number");
local %INC = %INC;
delete $INC{'Test2/IPC.pm'};
$one->reset();
+ $one->load();
my @events;
$one->stack->top->filter(sub { push @events => $_[1]; undef});
$one->stack->new_hub;
local *Test2::API::Breakage::report = sub { $ran++; return "foo" };
use warnings qw/redefine once/;
$one->reset();
+ $one->load();
my $stderr = "";
{
{
$one->reset();
+ $one->load();
my @events;
$one->stack->top->filter(sub { push @events => $_[1]; undef});
$one->stack->new_hub;
BEGIN { require "t/tools.pl" };
use Test2::Util qw/get_tid USE_THREADS try/;
use File::Temp qw/tempfile/;
+use File::Spec qw/catfile/;
use strict;
use warnings;
my $hid = '12345';
$ipc->add_hub($hid);
-ok(-f $ipc->tempdir . '/HUB-' . $hid, "wrote hub file");
-if(ok(open(my $fh, '<', $ipc->tempdir . '/HUB-' . $hid), "opened hub file")) {
+my $hubfile = File::Spec->catfile($ipc->tempdir, "HUB-$hid");
+ok(-f $hubfile, "wrote hub file");
+if(ok(open(my $fh, '<', $hubfile), "opened hub file")) {
my @lines = <$fh>;
close($fh);
is_deeply(
$ipc->send($hid, bless({ bar => 1 }, 'Foo'));
opendir(my $dh, $ipc->tempdir) || die "Could not open tempdir: !?";
-my @files = grep { $_ !~ m/^\.+$/ && $_ ne "HUB-$hid" } readdir($dh);
+my @files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB-$hid/ } readdir($dh);
closedir($dh);
is(@files, 2, "2 files added to the IPC directory");
);
opendir($dh, $ipc->tempdir) || die "Could not open tempdir: !?";
-@files = grep { $_ !~ m/^\.+$/ && $_ ne "HUB-$hid" } readdir($dh);
+@files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB-$hid/ } readdir($dh);
closedir($dh);
is(@files, 0, "All files collected");
1;
};
+ my $cleanup = sub {
+ if (opendir(my $d, $tmpdir)) {
+ for my $f (readdir($d)) {
+ next if $f =~ m/^\.+$/;
+ next unless -f "$tmpdir/$f";
+ unlink("$tmpdir/$f");
+ }
+ }
+ rmdir($tmpdir) or warn "Could not remove temp dir '$tmpdir': $!";
+ };
+ $cleanup->();
+
is($out->{STDOUT}, "not ok - IPC Fatal Error\nnot ok - IPC Fatal Error\n", "printed ");
like($out->{STDERR}, qr/IPC Temp Dir: \Q$tmpdir\E/m, "Got temp dir path");
$out = capture {
my $ipc = Test2::IPC::Driver::Files->new();
+ $tmpdir = $ipc->tempdir;
$ipc->add_hub($hid);
$ipc->send($hid, bless({ foo => 1 }, 'Foo'));
local $@;
eval { $ipc->drop_hub($hid) };
print STDERR $@ unless $@ =~ m/^255/;
};
+ $cleanup->();
like($out->{STDERR}, qr/IPC Fatal Error: Not all files from hub '12345' have been collected/, "Leftover files");
like($out->{STDERR}, qr/IPC Fatal Error: Leftover files in the directory \(.*\.ready\)/, "What file");
CAN_FORK
CAN_THREAD
CAN_REALLY_FORK
+
+ IS_WIN32
/;
{
CAN_THREAD();
CAN_FORK();
CAN_REALLY_FORK();
+IS_WIN32();
+
+is(IS_WIN32(), ($^O eq 'MSWin32') ? 1 : 0, "IS_WIN32 is correct ($^O)");
done_testing;
--- /dev/null
+use Test::Builder::Tester;
+use Test::More tests => 1;
+use strict;
+use warnings;
+
+BEGIN {
+ package Example::Tester;
+
+ use base 'Test::Builder::Module';
+ $INC{'Example/Tester.pm'} = 1;
+
+ sub import {
+ my $package = shift;
+ my %args = @_;
+ my $callerpack = caller;
+ my $tb = __PACKAGE__->builder;
+ $tb->exported_to($callerpack);
+ local $SIG{__WARN__} = sub { };
+ $tb->no_plan;
+ }
+}
+
+test_out('ok 1 - use Example::Tester;');
+use_ok('Example::Tester');
+test_test("use Example::Tester;");
isnt(undef, "foo", "'isnt' undef test 2");
like("foo", qr/o/, "'like' test");
unlike("foo", qr/a/, "'unlike' test");
-diag("Testing Diag");
+
note("Testing Note");
my $str = "abc";
https://perl5.git.perl.org / perl5.git / commitdiff