Upgrade Test-Simple from version 1.302073 to 1.302096
authorSteve Hay <steve.m.hay@googlemail.com>
Mon, 2 Oct 2017 13:03:48 +0000 (14:03 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Tue, 3 Oct 2017 07:56:11 +0000 (08:56 +0100)
(includes regen/lib_cleanup.pl)

156 files changed:
MANIFEST
Makefile.SH
Porting/Maintainers.pl
cpan/Test-Simple/lib/Test/Builder.pm
cpan/Test-Simple/lib/Test/Builder/Formatter.pm
cpan/Test-Simple/lib/Test/Builder/Module.pm
cpan/Test-Simple/lib/Test/Builder/Tester.pm
cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm
cpan/Test-Simple/lib/Test/More.pm
cpan/Test-Simple/lib/Test/Simple.pm
cpan/Test-Simple/lib/Test/Tester.pm
cpan/Test-Simple/lib/Test/Tester/Capture.pm
cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm
cpan/Test-Simple/lib/Test/Tester/Delegate.pm
cpan/Test-Simple/lib/Test/Tutorial.pod
cpan/Test-Simple/lib/Test/use/ok.pm
cpan/Test-Simple/lib/Test2.pm
cpan/Test-Simple/lib/Test2/API.pm
cpan/Test-Simple/lib/Test2/API/Breakage.pm
cpan/Test-Simple/lib/Test2/API/Context.pm
cpan/Test-Simple/lib/Test2/API/Instance.pm
cpan/Test-Simple/lib/Test2/API/Stack.pm
cpan/Test-Simple/lib/Test2/Event.pm
cpan/Test-Simple/lib/Test2/Event/Bail.pm
cpan/Test-Simple/lib/Test2/Event/Diag.pm
cpan/Test-Simple/lib/Test2/Event/Encoding.pm
cpan/Test-Simple/lib/Test2/Event/Exception.pm
cpan/Test-Simple/lib/Test2/Event/Fail.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/Event/Generic.pm
cpan/Test-Simple/lib/Test2/Event/Info.pm [deleted file]
cpan/Test-Simple/lib/Test2/Event/Note.pm
cpan/Test-Simple/lib/Test2/Event/Ok.pm
cpan/Test-Simple/lib/Test2/Event/Pass.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/Event/Plan.pm
cpan/Test-Simple/lib/Test2/Event/Skip.pm
cpan/Test-Simple/lib/Test2/Event/Subtest.pm
cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm
cpan/Test-Simple/lib/Test2/Event/Waiting.pm
cpan/Test-Simple/lib/Test2/EventFacet.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/About.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Control.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Error.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Info.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/Formatter.pm
cpan/Test-Simple/lib/Test2/Formatter/TAP.pm
cpan/Test-Simple/lib/Test2/Hub.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm
cpan/Test-Simple/lib/Test2/Hub/Subtest.pm
cpan/Test-Simple/lib/Test2/IPC.pm
cpan/Test-Simple/lib/Test2/IPC/Driver.pm
cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm
cpan/Test-Simple/lib/Test2/Tools/Tiny.pm
cpan/Test-Simple/lib/Test2/Transition.pod
cpan/Test-Simple/lib/Test2/Util.pm
cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm
cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/Util/HashBase.pm
cpan/Test-Simple/lib/Test2/Util/Trace.pm
cpan/Test-Simple/lib/ok.pm
cpan/Test-Simple/t/HashBase.t [moved from cpan/Test-Simple/t/Test2/modules/Util/HashBase.t with 60% similarity]
cpan/Test-Simple/t/Legacy/Builder/done_testing_double.t
cpan/Test-Simple/t/Legacy/Builder/done_testing_plan_mismatch.t
cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
cpan/Test-Simple/t/Legacy/Builder/is_passing.t
cpan/Test-Simple/t/Legacy/Builder/no_diag.t
cpan/Test-Simple/t/Legacy/Regression/637.t
cpan/Test-Simple/t/Legacy/Tester/tbt_08subtest.t
cpan/Test-Simple/t/Legacy/Tester/tbt_09do.t
cpan/Test-Simple/t/Legacy/bail_out.t
cpan/Test-Simple/t/Legacy/c_flag.t
cpan/Test-Simple/t/Legacy/died.t
cpan/Test-Simple/t/Legacy/extra.t
cpan/Test-Simple/t/Legacy/extra_one.t
cpan/Test-Simple/t/Legacy/fail-like.t
cpan/Test-Simple/t/Legacy/fail-more.t
cpan/Test-Simple/t/Legacy/fail.t
cpan/Test-Simple/t/Legacy/fail_one.t
cpan/Test-Simple/t/Legacy/missing.t
cpan/Test-Simple/t/Legacy/no_log_results.t [new file with mode: 0644]
cpan/Test-Simple/t/Legacy/no_plan.t
cpan/Test-Simple/t/Legacy/no_tests.t
cpan/Test-Simple/t/Legacy/skip.t
cpan/Test-Simple/t/Legacy/subtest/bail_out.t
cpan/Test-Simple/t/Legacy/subtest/basic.t
cpan/Test-Simple/t/Legacy/subtest/do.t
cpan/Test-Simple/t/Legacy/subtest/events.t
cpan/Test-Simple/t/Legacy/subtest/fork.t
cpan/Test-Simple/t/Legacy/undef.t
cpan/Test-Simple/t/Legacy/utf8.t
cpan/Test-Simple/t/Legacy/versions.t
cpan/Test-Simple/t/Legacy_And_Test2/builder_loaded_late.t
cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/behavior/Subtest_events.t
cpan/Test-Simple/t/Test2/behavior/Subtest_todo.t
cpan/Test-Simple/t/Test2/behavior/intercept.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/behavior/ipc_wait_timeout.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/behavior/no_load_api.t
cpan/Test-Simple/t/Test2/behavior/run_subtest_inherit.t
cpan/Test-Simple/t/Test2/behavior/special_names.t
cpan/Test-Simple/t/Test2/behavior/subtest_bailout.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/behavior/trace_signature.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/legacy/TAP.t
cpan/Test-Simple/t/Test2/modules/API/Context.t
cpan/Test-Simple/t/Test2/modules/API/Instance.t
cpan/Test-Simple/t/Test2/modules/Event.t
cpan/Test-Simple/t/Test2/modules/Event/Bail.t
cpan/Test-Simple/t/Test2/modules/Event/Diag.t
cpan/Test-Simple/t/Test2/modules/Event/Encoding.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/Event/Exception.t
cpan/Test-Simple/t/Test2/modules/Event/Fail.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/Event/Generic.t
cpan/Test-Simple/t/Test2/modules/Event/Info.t [deleted file]
cpan/Test-Simple/t/Test2/modules/Event/Note.t
cpan/Test-Simple/t/Test2/modules/Event/Ok.t
cpan/Test-Simple/t/Test2/modules/Event/Pass.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/Event/Plan.t
cpan/Test-Simple/t/Test2/modules/Event/Skip.t
cpan/Test-Simple/t/Test2/modules/Event/Subtest.t
cpan/Test-Simple/t/Test2/modules/Event/TAP/Version.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/Event/Waiting.t
cpan/Test-Simple/t/Test2/modules/EventFacet.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/About.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Amnesty.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Assert.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Control.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Error.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Info.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Meta.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Parent.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Plan.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/EventFacet/Trace.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/Formatter/TAP.t
cpan/Test-Simple/t/Test2/modules/Hub.t
cpan/Test-Simple/t/Test2/modules/Hub/Subtest.t
cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t
cpan/Test-Simple/t/Test2/modules/Tools/Tiny.t
cpan/Test-Simple/t/Test2/modules/Util.t
cpan/Test-Simple/t/Test2/modules/Util/Facets2Legacy.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/Util/Trace.t
cpan/Test-Simple/t/Test2/regression/746-forking-subtest.t [new file with mode: 0644]
cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm
cpan/Test-Simple/t/lib/Test/Simple/Catch.pm
cpan/Test-Simple/t/regression/696-intercept_skip_all.t
cpan/Test-Simple/t/regression/721-nested-streamed-subtest.t
cpan/Test-Simple/t/regression/757-reset_in_subtest.t [new file with mode: 0644]
cpan/Test-Simple/t/regression/buffered_subtest_plan_buffered.t [new file with mode: 0644]
cpan/Test-Simple/t/regression/builder_does_not_init.t [new file with mode: 0644]
t/porting/customized.dat

index e0997b0..ee45f3e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2640,15 +2640,27 @@ cpan/Test-Simple/lib/Test2/Event/Bail.pm
 cpan/Test-Simple/lib/Test2/Event/Diag.pm
 cpan/Test-Simple/lib/Test2/Event/Encoding.pm
 cpan/Test-Simple/lib/Test2/Event/Exception.pm
+cpan/Test-Simple/lib/Test2/Event/Fail.pm
 cpan/Test-Simple/lib/Test2/Event/Generic.pm
-cpan/Test-Simple/lib/Test2/Event/Info.pm
 cpan/Test-Simple/lib/Test2/Event/Note.pm
 cpan/Test-Simple/lib/Test2/Event/Ok.pm
+cpan/Test-Simple/lib/Test2/Event/Pass.pm
 cpan/Test-Simple/lib/Test2/Event/Plan.pm
 cpan/Test-Simple/lib/Test2/Event/Skip.pm
 cpan/Test-Simple/lib/Test2/Event/Subtest.pm
 cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm
 cpan/Test-Simple/lib/Test2/Event/Waiting.pm
+cpan/Test-Simple/lib/Test2/EventFacet.pm
+cpan/Test-Simple/lib/Test2/EventFacet/About.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Control.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Error.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Info.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm
+cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm
 cpan/Test-Simple/lib/Test2/Formatter.pm
 cpan/Test-Simple/lib/Test2/Formatter/TAP.pm
 cpan/Test-Simple/lib/Test2/Hub.pm
@@ -2662,8 +2674,10 @@ cpan/Test-Simple/lib/Test2/Tools/Tiny.pm
 cpan/Test-Simple/lib/Test2/Transition.pod
 cpan/Test-Simple/lib/Test2/Util.pm
 cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm
+cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm
 cpan/Test-Simple/lib/Test2/Util/HashBase.pm
 cpan/Test-Simple/lib/Test2/Util/Trace.pm
+cpan/Test-Simple/t/HashBase.t
 cpan/Test-Simple/t/Legacy/00test_harness_check.t
 cpan/Test-Simple/t/Legacy/01-basic.t
 cpan/Test-Simple/t/Legacy/478-cmp_ok_hash.t
@@ -2731,6 +2745,7 @@ cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
 cpan/Test-Simple/t/Legacy/missing.t
 cpan/Test-Simple/t/Legacy/More.t
 cpan/Test-Simple/t/Legacy/new_ok.t
+cpan/Test-Simple/t/Legacy/no_log_results.t
 cpan/Test-Simple/t/Legacy/no_plan.t
 cpan/Test-Simple/t/Legacy/no_tests.t
 cpan/Test-Simple/t/Legacy/note.t
@@ -2791,6 +2806,7 @@ cpan/Test-Simple/t/Legacy/utf8.t
 cpan/Test-Simple/t/Legacy/versions.t
 cpan/Test-Simple/t/Legacy_And_Test2/builder_loaded_late.t
 cpan/Test-Simple/t/Legacy_And_Test2/hidden_warnings.t
+cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t
 cpan/Test-Simple/t/lib/Dev/Null.pm
 cpan/Test-Simple/t/lib/Dummy.pm
 cpan/Test-Simple/t/lib/MyOverload.pm
@@ -2824,6 +2840,9 @@ cpan/Test-Simple/t/regression/684-nested_todo_diag.t
 cpan/Test-Simple/t/regression/694_note_diag_return_values.t
 cpan/Test-Simple/t/regression/696-intercept_skip_all.t
 cpan/Test-Simple/t/regression/721-nested-streamed-subtest.t
+cpan/Test-Simple/t/regression/757-reset_in_subtest.t
+cpan/Test-Simple/t/regression/buffered_subtest_plan_buffered.t
+cpan/Test-Simple/t/regression/builder_does_not_init.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
@@ -2835,15 +2854,19 @@ cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t
 cpan/Test-Simple/t/Test2/behavior/err_var.t
 cpan/Test-Simple/t/Test2/behavior/Formatter.t
 cpan/Test-Simple/t/Test2/behavior/init_croak.t
+cpan/Test-Simple/t/Test2/behavior/intercept.t
+cpan/Test-Simple/t/Test2/behavior/ipc_wait_timeout.t
 cpan/Test-Simple/t/Test2/behavior/nested_context_exception.t
 cpan/Test-Simple/t/Test2/behavior/no_load_api.t
 cpan/Test-Simple/t/Test2/behavior/run_subtest_inherit.t
 cpan/Test-Simple/t/Test2/behavior/special_names.t
+cpan/Test-Simple/t/Test2/behavior/subtest_bailout.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_buffer_formatter.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_events.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_plan.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_todo.t
 cpan/Test-Simple/t/Test2/behavior/Taint.t
+cpan/Test-Simple/t/Test2/behavior/trace_signature.t
 cpan/Test-Simple/t/Test2/legacy/TAP.t
 cpan/Test-Simple/t/Test2/modules/API.t
 cpan/Test-Simple/t/Test2/modules/API/Breakage.t
@@ -2853,15 +2876,29 @@ cpan/Test-Simple/t/Test2/modules/API/Stack.t
 cpan/Test-Simple/t/Test2/modules/Event.t
 cpan/Test-Simple/t/Test2/modules/Event/Bail.t
 cpan/Test-Simple/t/Test2/modules/Event/Diag.t
+cpan/Test-Simple/t/Test2/modules/Event/Encoding.t
 cpan/Test-Simple/t/Test2/modules/Event/Exception.t
+cpan/Test-Simple/t/Test2/modules/Event/Fail.t
 cpan/Test-Simple/t/Test2/modules/Event/Generic.t
-cpan/Test-Simple/t/Test2/modules/Event/Info.t
 cpan/Test-Simple/t/Test2/modules/Event/Note.t
 cpan/Test-Simple/t/Test2/modules/Event/Ok.t
+cpan/Test-Simple/t/Test2/modules/Event/Pass.t
 cpan/Test-Simple/t/Test2/modules/Event/Plan.t
 cpan/Test-Simple/t/Test2/modules/Event/Skip.t
 cpan/Test-Simple/t/Test2/modules/Event/Subtest.t
+cpan/Test-Simple/t/Test2/modules/Event/TAP/Version.t
 cpan/Test-Simple/t/Test2/modules/Event/Waiting.t
+cpan/Test-Simple/t/Test2/modules/EventFacet.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/About.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Amnesty.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Assert.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Control.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Error.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Info.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Meta.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Parent.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Plan.t
+cpan/Test-Simple/t/Test2/modules/EventFacet/Trace.t
 cpan/Test-Simple/t/Test2/modules/Formatter/TAP.t
 cpan/Test-Simple/t/Test2/modules/Hub.t
 cpan/Test-Simple/t/Test2/modules/Hub/Interceptor.t
@@ -2873,9 +2910,10 @@ cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t
 cpan/Test-Simple/t/Test2/modules/Tools/Tiny.t
 cpan/Test-Simple/t/Test2/modules/Util.t
 cpan/Test-Simple/t/Test2/modules/Util/ExternalMeta.t
-cpan/Test-Simple/t/Test2/modules/Util/HashBase.t
+cpan/Test-Simple/t/Test2/modules/Util/Facets2Legacy.t
 cpan/Test-Simple/t/Test2/modules/Util/Trace.t
 cpan/Test-Simple/t/Test2/regression/693_ipc_ordering.t
+cpan/Test-Simple/t/Test2/regression/746-forking-subtest.t
 cpan/Test-Simple/t/Test2/regression/gh_16.t
 cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t
 cpan/Text-Balanced/lib/Text/Balanced.pm        Text::Balanced
index 730dcca..37f58a9 100755 (executable)
@@ -1412,23 +1412,24 @@ _cleaner2:
        -rmdir lib/Unicode/Collate/CJK lib/Unicode/Collate lib/Tie/Hash
        -rmdir lib/Thread lib/Text lib/Test2/Util lib/Test2/Tools
        -rmdir lib/Test2/IPC/Driver lib/Test2/IPC lib/Test2/Hub/Interceptor
-       -rmdir lib/Test2/Hub lib/Test2/Formatter lib/Test2/Event/TAP
-       -rmdir lib/Test2/Event lib/Test2/API lib/Test2 lib/Test/use
-       -rmdir lib/Test/Tester lib/Test/Builder/Tester lib/Test/Builder/IO
-       -rmdir lib/Test/Builder lib/Test lib/Term lib/TAP/Parser/YAMLish
-       -rmdir lib/TAP/Parser/SourceHandler lib/TAP/Parser/Scheduler
-       -rmdir lib/TAP/Parser/Result lib/TAP/Parser/Iterator lib/TAP/Parser
-       -rmdir lib/TAP/Harness lib/TAP/Formatter/File
-       -rmdir lib/TAP/Formatter/Console lib/TAP/Formatter lib/TAP
-       -rmdir lib/Sys/Syslog lib/Sys lib/Sub lib/Search lib/Scalar
-       -rmdir lib/Pod/Text lib/Pod/Simple lib/Pod/Perldoc lib/PerlIO/via
-       -rmdir lib/PerlIO lib/Perl lib/Parse/CPAN lib/Parse lib/Params
-       -rmdir lib/Net/FTP lib/Module/Load lib/Module/CoreList lib/Module
-       -rmdir lib/Memoize lib/Math/BigInt lib/Math/BigFloat lib/Math lib/MIME
-       -rmdir lib/Locale/Maketext lib/Locale/Codes lib/Locale lib/List/Util
-       -rmdir lib/List lib/JSON/PP lib/JSON lib/IPC lib/IO/Uncompress/Adapter
-       -rmdir lib/IO/Uncompress lib/IO/Socket lib/IO/Compress/Zlib
-       -rmdir lib/IO/Compress/Zip lib/IO/Compress/Gzip lib/IO/Compress/Base
+       -rmdir lib/Test2/Hub lib/Test2/Formatter lib/Test2/EventFacet
+       -rmdir lib/Test2/Event/TAP lib/Test2/Event lib/Test2/API lib/Test2
+       -rmdir lib/Test/use lib/Test/Tester lib/Test/Builder/Tester
+       -rmdir lib/Test/Builder/IO lib/Test/Builder lib/Test lib/Term
+       -rmdir lib/TAP/Parser/YAMLish lib/TAP/Parser/SourceHandler
+       -rmdir lib/TAP/Parser/Scheduler lib/TAP/Parser/Result
+       -rmdir lib/TAP/Parser/Iterator lib/TAP/Parser lib/TAP/Harness
+       -rmdir lib/TAP/Formatter/File lib/TAP/Formatter/Console
+       -rmdir lib/TAP/Formatter lib/TAP lib/Sys/Syslog lib/Sys lib/Sub
+       -rmdir lib/Search lib/Scalar lib/Pod/Text lib/Pod/Simple
+       -rmdir lib/Pod/Perldoc lib/PerlIO/via lib/PerlIO lib/Perl
+       -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/Net/FTP lib/Module/Load
+       -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigInt
+       -rmdir lib/Math/BigFloat lib/Math lib/MIME lib/Locale/Maketext
+       -rmdir lib/Locale/Codes lib/Locale lib/List/Util lib/List lib/JSON/PP
+       -rmdir lib/JSON lib/IPC lib/IO/Uncompress/Adapter lib/IO/Uncompress
+       -rmdir lib/IO/Socket lib/IO/Compress/Zlib lib/IO/Compress/Zip
+       -rmdir lib/IO/Compress/Gzip lib/IO/Compress/Base
        -rmdir lib/IO/Compress/Adapter lib/IO/Compress lib/IO
        -rmdir lib/I18N/LangTags lib/I18N lib/Hash/Util lib/Hash lib/HTTP
        -rmdir lib/Filter/Util lib/Filter lib/File/Spec lib/ExtUtils/Typemaps
index 4dd14a7..fe4f676 100755 (executable)
@@ -1059,22 +1059,17 @@ use File::Glob qw(:case);
     },
 
     'Test::Simple' => {
-        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302073.tar.gz',
+        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302096.tar.gz',
         'FILES'        => q[cpan/Test-Simple],
         'EXCLUDED'     => [
             qr{^examples/},
             qr{^xt/},
             qw( appveyor.yml
-                perltidyrc
                 t/00compile.t
                 t/00-report.t
                 t/zzz-check-breaks.t
                 ),
         ],
-        'CUSTOMIZED'   => [
-            #
-            qw( t/Test2/modules/IPC/Driver/Files.t )
-        ],
     },
 
     'Text::Abbrev' => {
index 052e279..e2a0caa 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 BEGIN {
     if( $] < 5.008 ) {
@@ -42,6 +42,7 @@ our $Test = $ENV{TB_NO_EARLY_INIT} ? undef : Test::Builder->new;
 
 sub _add_ts_hooks {
     my $self = shift;
+
     my $hub = $self->{Stack}->top;
 
     # Take a reference to the hash key, we do this to avoid closing over $self
@@ -84,12 +85,26 @@ sub _add_ts_hooks {
     }, inherit => 1);
 }
 
+{
+    no warnings;
+    INIT {
+        use warnings;
+        Test2::API::test2_load() unless Test2::API::test2_in_preload();
+    }
+}
+
 sub new {
     my($class) = shift;
     unless($Test) {
-        my $ctx = context();
         $Test = $class->create(singleton => 1);
-        $ctx->release;
+
+        Test2::API::test2_add_callback_post_load(
+            sub {
+                $Test->{Original_Pid} = $$ if !$Test->{Original_Pid} || $Test->{Original_Pid} == 0;
+                $Test->reset(singleton => 1);
+                $Test->_add_ts_hooks;
+            }
+        );
 
         # 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.
@@ -117,9 +132,10 @@ sub create {
             formatter => Test::Builder::Formatter->new,
             ipc       => Test2::API::test2_ipc(),
         );
+
+        $self->reset(%params);
+        $self->_add_ts_hooks;
     }
-    $self->reset(%params);
-    $self->_add_ts_hooks;
 
     return $self;
 }
@@ -143,7 +159,8 @@ sub parent {
     my $chub = $self->{Hub} || $ctx->hub;
     $ctx->release;
 
-    my $parent = $chub->meta(__PACKAGE__, {})->{parent};
+    my $meta = $chub->meta(__PACKAGE__, {});
+    my $parent = $meta->{parent};
 
     return undef unless $parent;
 
@@ -187,7 +204,7 @@ sub child {
 
     $hub->listen(sub { push @$subevents => $_[1] });
 
-    $hub->set_nested( $parent->isa('Test2::Hub::Subtest') ? $parent->nested + 1 : 1 );
+    $hub->set_nested( $parent->nested + 1 );
 
     my $meta = $hub->meta(__PACKAGE__, {});
     $meta->{Name} = $name;
@@ -202,7 +219,7 @@ sub child {
     $self->_add_ts_hooks;
 
     $ctx->release;
-    return bless { Original_Pid => $$, Stack => $self->{Stack}, Hub => $hub }, blessed($self);
+    return bless { Original_Pid => $$, Stack => $self->{Stack}, Hub => $hub, no_log_results => $self->{no_log_results} }, blessed($self);
 }
 
 sub finalize {
@@ -229,7 +246,7 @@ sub finalize {
     my $trace = $ctx->trace;
     delete $ctx->hub->meta(__PACKAGE__, {})->{child};
 
-    $chub->finalize($trace, 1)
+    $chub->finalize($trace->snapshot(hid => $chub->hid, nested => $chub->nested), 1)
         if $ok
         && $chub->count
         && !$chub->no_ending
@@ -372,15 +389,21 @@ sub reset {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
     # hash keys is just asking for pain.  Also, it was documented.
     $Level = 1;
 
-    $self->{Original_Pid} = $$;
+    $self->{no_log_results} = $ENV{TEST_NO_LOG_RESULTS} ? 1 : 0
+        unless $params{singleton};
+
+    $self->{Original_Pid} = Test2::API::test2_in_preload() ? -1 : $$;
 
     my $ctx = $self->ctx;
+    my $hub = $ctx->hub;
+    $ctx->release;
     unless ($params{singleton}) {
-        $ctx->hub->reset_state();
-        $ctx->hub->set_pid($$);
-        $ctx->hub->set_tid(get_tid);
+        $hub->reset_state();
+        $hub->_tb_reset();
     }
 
+    $ctx = $self->ctx;
+
     my $meta = $ctx->hub->meta(__PACKAGE__, {});
     %$meta = (
         Name         => $0,
@@ -388,9 +411,10 @@ sub reset {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
         Done_Testing => undef,
         Skip_All     => 0,
         Test_Results => [],
+        parent       => $meta->{parent},
     );
 
-    $self->{Exported_To} = undef;
+    $self->{Exported_To} = undef unless $params{singleton};
 
     $self->{Orig_Handles} ||= do {
         my $format = $ctx->hub->format;
@@ -402,8 +426,8 @@ sub reset {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
     };
 
     $self->use_numbers(1);
-    $self->no_header(0);
-    $self->no_ending(0);
+    $self->no_header(0) unless $params{singleton};
+    $self->no_ending(0) unless $params{singleton};
     $self->reset_outputs;
 
     $ctx->release;
@@ -629,7 +653,7 @@ sub ok {
         (name => defined($name) ? $name : ''),
     };
 
-    $hub->{_meta}->{+__PACKAGE__}->{Test_Results}[ $hub->{count} ] = $result;
+    $hub->{_meta}->{+__PACKAGE__}->{Test_Results}[ $hub->{count} ] = $result unless $self->{no_log_results};
 
     my $orig_name = $name;
 
@@ -644,7 +668,7 @@ sub ok {
     }
 
     my $e = bless {
-        trace => bless( {%$trace}, 'Test2::Util::Trace'),
+        trace => bless( {%$trace}, 'Test2::EventFacet::Trace'),
         pass  => $test,
         name  => $name,
         _meta => {'Test::Builder' => $result},
@@ -667,9 +691,6 @@ sub _ok_debug {
 
     my $msg = $is_todo ? "Failed (TODO)" : "Failed";
 
-    my $dfh = $self->_diag_fh;
-    print $dfh "\n" if $ENV{HARNESS_ACTIVE} && $dfh;
-
     my (undef, $file, $line) = $trace->call;
     if (defined $orig_name) {
         $self->diag(qq[  $msg test '$orig_name'\n]);
@@ -1004,7 +1025,7 @@ sub skip {
         name      => $name,
         type      => 'skip',
         reason    => $why,
-    };
+    } unless $self->{no_log_results};
 
     $name =~ s|#|\\#|g;    # # in a name can confuse Test::Harness.
     $name =~ s{\n}{\n# }sg;
@@ -1029,7 +1050,7 @@ sub todo_skip {
         name      => '',
         type      => 'todo_skip',
         reason    => $why,
-    };
+    } unless $self->{no_log_results};
 
     $why =~ s{\n}{\n# }sg;
     my $tctx = $ctx->snapshot;
@@ -1196,8 +1217,17 @@ sub diag {
     my $self = shift;
     return unless @_;
 
+    my $text = join '' => map {defined($_) ? $_ : 'undef'} @_;
+
+    if (Test2::API::test2_in_preload()) {
+        chomp($text);
+        $text =~ s/^/# /msg;
+        print STDERR $text, "\n";
+        return 0;
+    }
+
     my $ctx = $self->ctx;
-    $ctx->diag(join '' => map {defined($_) ? $_ : 'undef'} @_);
+    $ctx->diag($text);
     $ctx->release;
     return 0;
 }
@@ -1207,8 +1237,17 @@ sub note {
     my $self = shift;
     return unless @_;
 
+    my $text = join '' => map {defined($_) ? $_ : 'undef'} @_;
+
+    if (Test2::API::test2_in_preload()) {
+        chomp($text);
+        $text =~ s/^/# /msg;
+        print STDOUT $text, "\n";
+        return 0;
+    }
+
     my $ctx = $self->ctx;
-    $ctx->note(join '' => map {defined($_) ? $_ : 'undef'} @_);
+    $ctx->note($text);
     $ctx->release;
     return 0;
 }
@@ -1351,23 +1390,25 @@ sub current_test {
     if( defined $num ) {
         $hub->set_count($num);
 
-        # If the test counter is being pushed forward fill in the details.
-        my $test_results = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results};
-        if( $num > @$test_results ) {
-            my $start = @$test_results ? @$test_results : 0;
-            for( $start .. $num - 1 ) {
-                $test_results->[$_] = {
-                    'ok'      => 1,
-                    actual_ok => undef,
-                    reason    => 'incrementing test number',
-                    type      => 'unknown',
-                    name      => undef
-                };
+        unless ($self->{no_log_results}) {
+            # If the test counter is being pushed forward fill in the details.
+            my $test_results = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results};
+            if ($num > @$test_results) {
+                my $start = @$test_results ? @$test_results : 0;
+                for ($start .. $num - 1) {
+                    $test_results->[$_] = {
+                        'ok'      => 1,
+                        actual_ok => undef,
+                        reason    => 'incrementing test number',
+                        type      => 'unknown',
+                        name      => undef
+                    };
+                }
+            }
+            # If backward, wipe history.  Its their funeral.
+            elsif ($num < @$test_results) {
+                $#{$test_results} = $num - 1;
             }
-        }
-        # If backward, wipe history.  Its their funeral.
-        elsif( $num < @$test_results ) {
-            $#{$test_results} = $num - 1;
         }
     }
     return release $ctx, $hub->count;
@@ -1393,6 +1434,8 @@ sub is_passing {
 sub summary {
     my($self) = shift;
 
+    return if $self->{no_log_results};
+
     my $ctx = $self->ctx;
     my $data = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results};
     $ctx->release;
@@ -1402,6 +1445,9 @@ sub summary {
 
 sub details {
     my $self = shift;
+
+    return if $self->{no_log_results};
+
     my $ctx = $self->ctx;
     my $data = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results};
     $ctx->release;
@@ -1702,12 +1748,15 @@ sub coordinate_forks {
     }
     Test2::IPC->import;
     Test2::API::test2_ipc_enable_polling();
+    Test2::API::test2_load();
     my $ipc = Test2::IPC::apply_ipc($self->{Stack});
     $ipc->set_no_fatal(1);
     Test2::API::test2_no_wait(1);
     Test2::API::test2_ipc_enable_shm();
 }
 
+sub no_log_results { $_[0]->{no_log_results} = 1 }
+
 1;
 
 __END__
@@ -2082,7 +2131,7 @@ test failed.
 
 Defaults to 1.
 
-Setting L<$Test::Builder::Level> overrides.  This is typically useful
+Setting C<$Test::Builder::Level> overrides.  This is typically useful
 localized:
 
     sub my_ok {
@@ -2251,6 +2300,16 @@ point where the original test function was called (C<< $tb->caller >>).
 
 =over 4
 
+=item B<no_log_results>
+
+This will turn off result long-term storage. Calling this method will make
+C<details> and C<summary> useless. You may want to use this if you are running
+enough tests to fill up all available memory.
+
+    Test::Builder->new->no_log_results();
+
+There is no way to turn it back on.
+
 =item B<current_test>
 
     my $curr_test = $Test->current_test;
index 96571c6..44b7cd4 100644 (file)
@@ -2,7 +2,7 @@ package Test::Builder::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) }
 
@@ -16,43 +16,42 @@ BEGIN {
     *OUT_TODO = sub() { $todo };
 }
 
-__PACKAGE__->register_event('Test::Builder::TodoDiag', 'event_todo_diag');
-
 sub init {
     my $self = shift;
     $self->SUPER::init(@_);
     $self->{+HANDLES}->[OUT_TODO] = $self->{+HANDLES}->[OUT_STD];
 }
 
-sub event_todo_diag {
-    my $self = shift;
-    my @out = $self->event_diag(@_);
-    $out[0]->[0] = OUT_TODO();
-    return @out;
+sub plan_tap {
+    my ($self, $f) = @_;
+
+    return if $self->{+NO_HEADER};
+    return $self->SUPER::plan_tap($f);
 }
 
-sub event_diag {
-    my $self = shift;
+sub debug_tap {
+    my ($self, $f, $num) = @_;
     return if $self->{+NO_DIAG};
-    return $self->SUPER::event_diag(@_);
+    my @out = $self->SUPER::debug_tap($f, $num);
+    $self->redirect(\@out) if @out && $f->{about}->{package} eq 'Test::Builder::TodoDiag';
+    return @out;
 }
 
-sub event_plan {
-    my $self = shift;
-    return if $self->{+NO_HEADER};
-    return $self->SUPER::event_plan(@_);
+sub info_tap {
+    my ($self, $f) = @_;
+    return if $self->{+NO_DIAG};
+    my @out = $self->SUPER::info_tap($f);
+    $self->redirect(\@out) if @out && $f->{about}->{package} eq 'Test::Builder::TodoDiag';
+    return @out;
 }
 
-sub event_ok_multiline {
-    my $self = shift;
-    my ($out, $space, @extra) = @_;
-
-    return(
-        [OUT_STD, "$out\n"],
-        map {[OUT_STD, "# $_\n"]} @extra,
-    );
+sub redirect {
+    my ($self, $out) = @_;
+    $_->[0] = OUT_TODO for @$out;
 }
 
+sub no_subtest_space { 1 }
+
 1;
 
 __END__
@@ -73,22 +72,6 @@ This is what takes events and turns them into TAP.
 
     use Test::Builder; # Loads Test::Builder::Formatter for you
 
-=head1 METHODS
-
-=over 4
-
-=item $f->event_todo_diag
-
-Additional method used to process L<Test::Builder::TodoDiag> events.
-
-=item $f->event_diag
-
-=item $f->event_plan
-
-These override the parent class methods to do nothing if C<no_header> is set.
-
-=back
-
 =head1 SOURCE
 
 The source code repository for Test2 can be found at
@@ -112,7 +95,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 6fbba79..1114ec9 100644 (file)
@@ -7,7 +7,7 @@ use Test::Builder;
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 =head1 NAME
@@ -75,6 +75,8 @@ C<import_extra()>.
 sub import {
     my($class) = shift;
 
+    Test2::API::test2_load() unless Test2::API::test2_in_preload();
+
     # Don't run all this when loading ourself.
     return 1 if $class eq 'Test::Builder::Module';
 
index 647ea2d..00dc38d 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 use Test::Builder;
 use Symbol;
@@ -117,7 +117,7 @@ sub _start_testing {
     $original_harness_env = $ENV{HARNESS_ACTIVE} || 0;
     $ENV{HARNESS_ACTIVE} = 0;
 
-    my $hub = $t->{Hub} || Test2::API::test2_stack->top;
+    my $hub = $t->{Hub} || ($t->{Stack} ? $t->{Stack}->top : Test2::API::test2_stack->top);
     $original_formatter = $hub->format;
     unless ($original_formatter && $original_formatter->isa('Test::Builder::Formatter')) {
         my $fmt = Test::Builder::Formatter->new;
index 939e7f1..a3f1f70 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester::Color;
 
 use strict;
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 require Test::Builder::Tester;
 
index 74ae078..8c02d73 100644 (file)
@@ -2,12 +2,19 @@ package Test::Builder::TodoDiag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) }
 
 sub diagnostics { 0 }
 
+sub facet_data {
+    my $self = shift;
+    my $out = $self->SUPER::facet_data();
+    $out->{info}->[0]->{debug} = 0;
+    return $out;
+}
+
 1;
 
 __END__
@@ -51,7 +58,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 2863c1b..4c08fea 100644 (file)
@@ -17,7 +17,7 @@ sub _carp {
     return warn @_, " at $file line $line\n";
 }
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index f148fe6..16a6574 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 
 use strict;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index a324a1b..b8dde12 100644 (file)
@@ -18,7 +18,7 @@ require Exporter;
 
 use vars qw( @ISA @EXPORT );
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 @EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
 @ISA = qw( Exporter );
index d8eb170..e6965fc 100644 (file)
@@ -2,7 +2,7 @@ use strict;
 
 package Test::Tester::Capture;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Test::Builder;
index bed18e8..18c17f7 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 
 package Test::Tester::CaptureRunner;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Test::Tester::Capture;
index ed627db..8e87ca6 100644 (file)
@@ -3,7 +3,7 @@ use warnings;
 
 package Test::Tester::Delegate;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 use Scalar::Util();
 
index a71a9c1..eb38018 100644 (file)
@@ -297,7 +297,7 @@ Now we can test bunches of dates by just adding them to
 C<%ICal_Dates>.  Now that it's less work to test with more dates, you'll
 be inclined to just throw more in as you think of them.
 Only problem is, every time we add to that we have to keep adjusting
-the L<< use Test::More tests => ## >> line.  That can rapidly get
+the C<< use Test::More tests => ## >> line.  That can rapidly get
 annoying.  There are ways to make this work better.
 
 First, we can calculate the plan dynamically using the C<plan()>
@@ -358,7 +358,7 @@ for you or for the next person who runs your test.
 
 =head2 Skipping tests
 
-Poking around in the existing Date::ICal tests, I found this in
+Poking around in the existing L<Date::ICal> tests, I found this in
 F<t/01sanity.t> [7]
 
     #!/usr/bin/perl -w
index fdc7326..042996b 100644 (file)
@@ -1,7 +1,7 @@
 package Test::use::ok;
 use 5.005;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 __END__
index 1b65b33..61eee99 100644 (file)
@@ -2,7 +2,7 @@ package Test2;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 1;
@@ -203,7 +203,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 41cd0af..e43a0d6 100644 (file)
@@ -2,12 +2,14 @@ package Test2::API;
 use strict;
 use warnings;
 
+use Test2::Util qw/USE_THREADS/;
+
 BEGIN {
     $ENV{TEST_ACTIVE} ||= 1;
     $ENV{TEST2_ACTIVE} = 1;
 }
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 my $INST;
@@ -16,12 +18,23 @@ sub test2_set_is_end { ($ENDING) = @_ ? @_ : (1) }
 sub test2_get_is_end { $ENDING }
 
 use Test2::API::Instance(\$INST);
+
 # Set the exit status
 END {
     test2_set_is_end(); # See gh #16
     $INST->set_exit();
 }
 
+sub CLONE {
+    my $init = test2_init_done();
+    my $load = test2_load_done();
+
+    return if $init && $load;
+
+    require Carp;
+    Carp::croak "Test2 must be fully loaded before you start a new thread!\n";
+}
+
 # See gh #16
 {
     no warnings;
@@ -38,7 +51,8 @@ BEGIN {
     }
 }
 
-use Test2::Util::Trace();
+use Test2::EventFacet::Trace();
+use Test2::Util::Trace(); # Legacy
 
 use Test2::Hub::Subtest();
 use Test2::Hub::Interceptor();
@@ -56,17 +70,21 @@ use Test2::Event::Subtest();
 
 use Carp qw/carp croak confess longmess/;
 use Scalar::Util qw/blessed weaken/;
-use Test2::Util qw/get_tid/;
+use Test2::Util qw/get_tid clone_io pkg_to_file/;
 
 our @EXPORT_OK = qw{
     context release
     context_do
     no_context
-    intercept
+    intercept intercept_deep
     run_subtest
 
     test2_init_done
     test2_load_done
+    test2_load
+    test2_start_preload
+    test2_stop_preload
+    test2_in_preload
 
     test2_set_is_end
     test2_get_is_end
@@ -97,12 +115,18 @@ our @EXPORT_OK = qw{
     test2_ipc_enable_polling
     test2_ipc_get_pending
     test2_ipc_set_pending
+    test2_ipc_get_timeout
+    test2_ipc_set_timeout
     test2_ipc_enable_shm
 
     test2_formatter
     test2_formatters
     test2_formatter_add
     test2_formatter_set
+
+    test2_stdout
+    test2_stderr
+    test2_reset_io
 };
 BEGIN { require Exporter; our @ISA = qw(Exporter) }
 
@@ -111,9 +135,29 @@ my $CONTEXTS    = $INST->contexts;
 my $INIT_CBS    = $INST->context_init_callbacks;
 my $ACQUIRE_CBS = $INST->context_acquire_callbacks;
 
+my $STDOUT = clone_io(\*STDOUT);
+my $STDERR = clone_io(\*STDERR);
+sub test2_stdout { $STDOUT ||= clone_io(\*STDOUT) }
+sub test2_stderr { $STDERR ||= clone_io(\*STDERR) }
+
+sub test2_post_preload_reset {
+    test2_reset_io();
+    $INST->post_preload_reset;
+}
+
+sub test2_reset_io {
+    $STDOUT = clone_io(\*STDOUT);
+    $STDERR = clone_io(\*STDERR);
+}
+
 sub test2_init_done { $INST->finalized }
 sub test2_load_done { $INST->loaded }
 
+sub test2_load          { $INST->load }
+sub test2_start_preload { $ENV{T2_IN_PRELOAD} = 1; $INST->start_preload }
+sub test2_stop_preload  { $ENV{T2_IN_PRELOAD} = 0; $INST->stop_preload }
+sub test2_in_preload    { $INST->preload }
+
 sub test2_pid     { $INST->pid }
 sub test2_tid     { $INST->tid }
 sub test2_stack   { $INST->stack }
@@ -143,9 +187,21 @@ sub test2_ipc_enable_polling  { $INST->enable_ipc_polling }
 sub test2_ipc_disable_polling { $INST->disable_ipc_polling }
 sub test2_ipc_get_pending     { $INST->get_ipc_pending }
 sub test2_ipc_set_pending     { $INST->set_ipc_pending(@_) }
+sub test2_ipc_set_timeout     { $INST->set_ipc_timeout(@_) }
+sub test2_ipc_get_timeout     { $INST->ipc_timeout() }
 sub test2_ipc_enable_shm      { $INST->ipc_enable_shm }
 
-sub test2_formatter     { $INST->formatter }
+sub test2_formatter     {
+    if ($ENV{T2_FORMATTER} && $ENV{T2_FORMATTER} =~ m/^(\+)?(.*)$/) {
+        my $formatter = $1 ? $2 : "Test2::Formatter::$2";
+        my $file = pkg_to_file($formatter);
+        require $file;
+        return $formatter;
+    }
+
+    return $INST->formatter;
+}
+
 sub test2_formatters    { @{$INST->formatters} }
 sub test2_formatter_add { $INST->add_formatter(@_) }
 sub test2_formatter_set {
@@ -207,6 +263,7 @@ sub no_context(&;$) {
     return;
 };
 
+my $CID = 1;
 sub context {
     # We need to grab these before anything else to ensure they are not
     # changed.
@@ -283,11 +340,15 @@ sub context {
     # hit with how often this needs to be called.
     my $trace = bless(
         {
-            frame => [$pkg, $file, $line, $sub],
-            pid   => $$,
-            tid   => get_tid(),
+            frame    => [$pkg, $file, $line, $sub],
+            pid      => $$,
+            tid      => get_tid(),
+            cid      => 'C' . $CID++,
+            hid      => $hid,
+            nested   => $hub->{nested},
+            buffered => $hub->{buffered},
         },
-        'Test2::Util::Trace'
+        'Test2::EventFacet::Trace'
     );
 
     # Directly bless the object here, calling new is a noticeable performance
@@ -374,7 +435,29 @@ sub release($;$) {
 
 sub intercept(&) {
     my $code = shift;
+    my $ctx = context();
+
+    my $events = _intercept($code, deep => 0);
+
+    $ctx->release;
+
+    return $events;
+}
+
+sub intercept_deep(&) {
+    my $code = shift;
+    my $ctx = context();
+
+    my $events = _intercept($code, deep => 1);
 
+    $ctx->release;
+
+    return $events;
+}
+
+sub _intercept {
+    my $code = shift;
+    my %params = @_;
     my $ctx = context();
 
     my $ipc;
@@ -389,7 +472,7 @@ sub intercept(&) {
     );
 
     my @events;
-    $hub->listen(sub { push @events => $_[1] });
+    $hub->listen(sub { push @events => $_[1] }, inherit => $params{deep});
 
     $ctx->stack->top; # Make sure there is a top hub before we begin.
     $ctx->stack->push($hub);
@@ -427,23 +510,26 @@ sub run_subtest {
     my ($name, $code, $params, @args) = @_;
 
     $params = {buffered => $params} unless ref $params;
-    my $buffered      = delete $params->{buffered};
     my $inherit_trace = delete $params->{inherit_trace};
 
     my $ctx = context();
 
-    $ctx->note($name) unless $buffered;
-
     my $parent = $ctx->hub;
 
+    # If a parent is buffered then the child must be as well.
+    my $buffered = $params->{buffered} || $parent->{buffered};
+
+    $ctx->note($name) unless $buffered;
+
     my $stack = $ctx->stack || $STACK;
     my $hub = $stack->new_hub(
         class => 'Test2::Hub::Subtest',
+        buffered => $buffered,
         %$params,
+        buffered => $buffered,
     );
 
     my @events;
-    $hub->set_nested( $parent->isa('Test2::Hub::Subtest') ? $parent->nested + 1 : 1 );
     $hub->listen(sub { push @events => $_[1] });
 
     if ($buffered) {
@@ -452,14 +538,6 @@ sub run_subtest {
             $hub->format(undef) if $hide;
         }
     }
-    elsif (! $parent->format) {
-        # If our parent has no format that means we're in a buffered subtest
-        # and now we're trying to run a streaming subtest. There's really no
-        # way for that to work, so we need to force the use of a buffered
-        # subtest here as
-        # well. https://github.com/Test-More/test-more/issues/721
-        $buffered = 1;
-    }
 
     if ($inherit_trace) {
         my $orig = $code;
@@ -487,20 +565,44 @@ sub run_subtest {
             $finished = 1;
         }
     }
+
+    if ($params->{no_fork}) {
+        if ($$ != $ctx->trace->pid) {
+            warn $ok ? "Forked inside subtest, but subtest never finished!\n" : $err;
+            exit 255;
+        }
+
+        if (get_tid() != $ctx->trace->tid) {
+            warn $ok ? "Started new thread inside subtest, but thread never finished!\n" : $err;
+            exit 255;
+        }
+    }
+    elsif (!$parent->is_local && !$parent->ipc) {
+        warn $ok ? "A new process or thread was started inside subtest, but IPC is not enabled!\n" : $err;
+        exit 255;
+    }
+
     $stack->pop($hub);
 
     my $trace = $ctx->trace;
 
+    my $bailed = $hub->bailed_out;
+
     if (!$finished) {
-        if(my $bailed = $hub->bailed_out) {
+        if ($bailed && !$buffered) {
             $ctx->bail($bailed->reason);
         }
-        my $code = $hub->exit_code;
-        $ok = !$code;
-        $err = "Subtest ended with exit code $code" if $code;
+        elsif ($bailed && $buffered) {
+            $ok = 1;
+        }
+        else {
+            my $code = $hub->exit_code;
+            $ok = !$code;
+            $err = "Subtest ended with exit code $code" if $code;
+        }
     }
 
-    $hub->finalize($trace, 1)
+    $hub->finalize($trace->snapshot(hid => $hub->hid, nested => $hub->nested, buffered => $buffered), 1)
         if $ok
         && !$hub->no_ending
         && !$hub->ended;
@@ -526,6 +628,8 @@ sub run_subtest {
     $ctx->diag("Bad subtest plan, expected " . $hub->plan . " but ran " . $hub->count)
         if defined($plan_ok) && !$plan_ok;
 
+    $ctx->bail($bailed->reason) if $bailed && $buffered;
+
     $ctx->release;
     return $pass;
 }
@@ -618,6 +722,35 @@ generated by the test system:
     my_ok($events->[0]->pass, "first event passed");
     my_ok(!$events->[1]->pass, "second event failed");
 
+=head3 DEEP EVENT INTERCEPTION
+
+Normally C<intercept { ... }> only intercepts events sent to the main hub (as
+added by intercept itself). Nested hubs, such as those created by subtests,
+will not be intercepted. This is normally what you will still see the nested
+events by inspecting the subtest event. However there are times where you want
+to verify each event as it is sent, in that case use C<intercept_deep { ... }>.
+
+    my $events = intercept_Deep {
+        buffered_subtest foo => sub {
+            ok(1, "pass");
+        };
+    };
+
+C<$events> in this case will contain 3 items:
+
+=over 4
+
+=item The event from C<ok(1, "pass")>
+
+=item The plan event for the subtest
+
+=item The subtest event itself, with the first 2 events nested inside it as children.
+
+=back
+
+This lets you see the order in which the events were sent, unlike
+C<intercept { ... }> which only lets you see events as the main hub sees them.
+
 =head2 OTHER API FUNCTIONS
 
     use Test2::API qw{
@@ -958,6 +1091,12 @@ created for the hub that shares the same trace as the current context.
 Set this to true if your tool is producing subtests without user-specified
 subs.
 
+=item 'no_fork' => $bool
+
+Defaults to off. Normally forking inside a subtest will actually fork the
+subtest, resulting in 2 final subtest events. This parameter will turn off that
+behavior, only the original process/thread will return a final subtest event.
+
 =back
 
 =item @ARGS
@@ -1213,6 +1352,15 @@ This returns 0 if there are (most likely) no pending events.
 This returns 1 if there are (likely) pending events. Upon return it will reset,
 nothing else will be able to see that there were pending events.
 
+=item $timeout = test2_ipc_get_timeout()
+
+=item test2_ipc_set_timeout($timeout)
+
+Get/Set the timeout value for the IPC system. This timeout is how long the IPC
+system will wait for child processes and threads to finish before aborting.
+
+The default value is C<30> seconds.
+
 =back
 
 =head2 MANAGING FORMATTERS
@@ -1300,7 +1448,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index b85e4d5..f97984f 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Breakage;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Test2::Util qw/pkg_to_file/;
@@ -31,7 +31,12 @@ sub upgrade_required {
         'Test::SharedFork'        => '0.34',
         'Test::Alien'             => '0.04',
         'Test::UseAllModules'     => '0.14',
+        'Test::More::Prefix'      => '0.005',
 
+        'Test2::Tools::EventDumper' => 0.000007,
+        'Test2::Harness'            => 0.000013,
+
+        'Test::DBIx::Class::Schema'    => '1.0.9',
         'Test::Clustericious::Cluster' => '0.30',
     );
 }
@@ -43,12 +48,10 @@ sub known_broken {
         'Test::Aggregate'       => '0.373',
         'Test::Flatten'         => '0.11',
         'Test::Group'           => '0.20',
-        'Test::More::Prefix'    => '0.005',
         'Test::ParallelSubtest' => '0.05',
         'Test::Pretty'          => '0.32',
         'Test::Wrapper'         => '0.3.0',
 
-        'Test::DBIx::Class::Schema'      => '1.0.9',
         'Log::Dispatch::Config::TestLog' => '0.02',
     );
 }
@@ -165,7 +168,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 7660fa6..db803c0 100644 (file)
@@ -2,14 +2,14 @@ package Test2::API::Context;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Carp qw/confess croak longmess/;
 use Scalar::Util qw/weaken blessed/;
 use Test2::Util qw/get_tid try pkg_to_file get_tid/;
 
-use Test2::Util::Trace();
+use Test2::EventFacet::Trace();
 use Test2::API();
 
 # Preload some key event types
@@ -19,7 +19,7 @@ my %LOADED = (
         my $file = "Test2/Event/$_.pm";
         require $file unless $INC{$file};
         ( $pkg => $pkg, $_ => $pkg )
-    } qw/Ok Diag Note Info Plan Bail Exception Waiting Skip Subtest/
+    } qw/Ok Diag Note Plan Bail Exception Waiting Skip Subtest Pass Fail/
 );
 
 use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
@@ -155,9 +155,7 @@ sub do_in_context {
     # We need to update the pid/tid and error vars.
     my $clone = $self->snapshot;
     @$clone{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} = ($!, $@, $?);
-    $clone->{+TRACE} = $clone->{+TRACE}->snapshot;
-    $clone->{+TRACE}->set_pid($$);
-    $clone->{+TRACE}->set_tid(get_tid());
+    $clone->{+TRACE} = $clone->{+TRACE}->snapshot(pid => $$, tid => get_tid());
 
     my $hub = $clone->{+HUB};
     my $hid = $hub->hid;
@@ -202,6 +200,13 @@ sub alert {
     $self->trace->alert($msg);
 }
 
+sub send_event_and_release {
+    my $self = shift;
+    my $out = $self->send_event(@_);
+    $self->release;
+    return $out;
+}
+
 sub send_event {
     my $self  = shift;
     my $event = shift;
@@ -209,12 +214,19 @@ sub send_event {
 
     my $pkg = $LOADED{$event} || $self->_parse_event($event);
 
-    my $e = $pkg->new(
-        trace => $self->{+TRACE}->snapshot,
-        %args,
-    );
+    my $e;
+    {
+        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+        $e = $pkg->new(
+            trace => $self->{+TRACE}->snapshot,
+            %args,
+        );
+    }
 
-    ${$self->{+_ABORTED}}++ if $self->{+_ABORTED} && defined $e->terminate;
+    if ($self->{+_ABORTED}) {
+        my $f = $e->facet_data;
+        ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate);
+    }
     $self->{+HUB}->send($e);
 }
 
@@ -225,12 +237,81 @@ sub build_event {
 
     my $pkg = $LOADED{$event} || $self->_parse_event($event);
 
+    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
     $pkg->new(
         trace => $self->{+TRACE}->snapshot,
         %args,
     );
 }
 
+sub pass {
+    my $self = shift;
+    my ($name) = @_;
+
+    my $e = bless(
+        {
+            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
+            name  => $name,
+        },
+        "Test2::Event::Pass"
+    );
+
+    $self->{+HUB}->send($e);
+    return $e;
+}
+
+sub pass_and_release {
+    my $self = shift;
+    my ($name) = @_;
+
+    my $e = bless(
+        {
+            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
+            name  => $name,
+        },
+        "Test2::Event::Pass"
+    );
+
+    $self->{+HUB}->send($e);
+    $self->release;
+    return 1;
+}
+
+sub fail {
+    my $self = shift;
+    my ($name, @diag) = @_;
+
+    my $e = bless(
+        {
+            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
+            name  => $name,
+        },
+        "Test2::Event::Fail"
+    );
+
+    $e->add_info({tag => 'DIAG', debug => 1, details => $_}) for @diag;
+    $self->{+HUB}->send($e);
+    return $e;
+}
+
+sub fail_and_release {
+    my $self = shift;
+    my ($name, @diag) = @_;
+
+    my $e = bless(
+        {
+            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
+            name  => $name,
+        },
+        "Test2::Event::Fail"
+    );
+
+    $e->add_info({tag => 'DIAG', debug => 1, details => $_}) for @diag;
+    $self->{+HUB}->send($e);
+    $self->release;
+    return 0;
+}
+
 sub ok {
     my $self = shift;
     my ($pass, $name, $on_fail) = @_;
@@ -238,7 +319,7 @@ sub ok {
     my $hub = $self->{+HUB};
 
     my $e = bless {
-        trace => bless( {%{$self->{+TRACE}}}, 'Test2::Util::Trace'),
+        trace => bless( {%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
         pass  => $pass,
         name  => $name,
     }, 'Test2::Event::Ok';
@@ -250,14 +331,7 @@ sub ok {
     $self->failure_diag($e);
 
     if ($on_fail && @$on_fail) {
-        for my $of (@$on_fail) {
-            if (ref($of) eq 'CODE' || (blessed($of) && $of->can('render'))) {
-                $self->info($of, diagnostics => 1);
-            }
-            else {
-                $self->diag($of);
-            }
-        }
+        $self->diag($_) for @$on_fail;
     }
 
     return $e;
@@ -267,13 +341,6 @@ sub failure_diag {
     my $self = shift;
     my ($e) = @_;
 
-    # This behavior is inherited from Test::Builder which injected a newline at
-    # the start of the first diagnostics when the harness is active, but not
-    # verbose. This is important to keep the diagnostics from showing up
-    # appended to the existing line, which is hard to read. In a verbose
-    # harness there is no need for this.
-    my $prefix = $ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_IS_VERBOSE} ? "\n" : "";
-
     # Figure out the debug info, this is typically the file name and line
     # number, but can also be a custom message. If no trace object is provided
     # then we have nothing useful to display.
@@ -284,8 +351,8 @@ sub failure_diag {
     # Create the initial diagnostics. If the test has a name we put the debug
     # info on a second line, this behavior is inherited from Test::Builder.
     my $msg = defined($name)
-        ? qq[${prefix}Failed test '$name'\n$debug.\n]
-        : qq[${prefix}Failed test $debug.\n];
+        ? qq[Failed test '$name'\n$debug.\n]
+        : qq[Failed test $debug.\n];
 
     $self->diag($msg);
 }
@@ -302,12 +369,6 @@ sub skip {
     );
 }
 
-sub info {
-    my $self = shift;
-    my ($renderer, %params) = @_;
-    $self->send_event('Info', renderer => $renderer, %params);
-}
-
 sub note {
     my $self = shift;
     my ($message) = @_;
@@ -509,7 +570,7 @@ current one to which all events should be sent.
 
 =item $dbg = $ctx->trace()
 
-This will return the L<Test2::Util::Trace> instance used by the context.
+This will return the L<Test2::EventFacet::Trace> instance used by the context.
 
 =item $ctx->do_in_context(\&code, @args);
 
@@ -555,23 +616,100 @@ The value of C<$@> when the context was created.
 
 =over 4
 
+=item $event = $ctx->pass()
+
+=item $event = $ctx->pass($name)
+
+This will send and return an L<Test2::Event::Pass> event. You may optionally
+provide a C<$name> for the assertion.
+
+The L<Test2::Event::Pass> is a specially crafted and optimized event, using
+this will help the performance of passing tests.
+
+=item $true = $ctx->pass_and_release()
+
+=item $true = $ctx->pass_and_release($name)
+
+This is a combination of C<pass()> and C<release()>. You can use this if you do
+not plan to do anything with the context after sending the event. This helps
+write more clear and compact code.
+
+    sub shorthand {
+        my ($bool, $name) = @_;
+        my $ctx = context();
+        return $ctx->pass_and_release($name) if $bool;
+
+        ... Handle a failure ...
+    }
+
+    sub longform {
+        my ($bool, $name) = @_;
+        my $ctx = context();
+
+        if ($bool) {
+            $ctx->pass($name);
+            $ctx->release;
+            return 1;
+        }
+
+        ... Handle a failure ...
+    }
+
+=item my $event = $ctx->fail()
+
+=item my $event = $ctx->fail($name)
+
+=item my $event = $ctx->fail($name, @diagnostics)
+
+This lets you send an L<Test2::Event::Fail> event. You may optionally provide a
+C<$name> and C<@diagnostics> messages.
+
+=item my $false = $ctx->fail_and_release()
+
+=item my $false = $ctx->fail_and_release($name)
+
+=item my $false = $ctx->fail_and_release($name, @diagnostics)
+
+This is a combination of C<fail()> and C<release()>. This can be used to write
+clearer and shorter code.
+
+    sub shorthand {
+        my ($bool, $name) = @_;
+        my $ctx = context();
+        return $ctx->fail_and_release($name) unless $bool;
+
+        ... Handle a success ...
+    }
+
+    sub longform {
+        my ($bool, $name) = @_;
+        my $ctx = context();
+
+        unless ($bool) {
+            $ctx->pass($name);
+            $ctx->release;
+            return 1;
+        }
+
+        ... Handle a success ...
+    }
+
+
 =item $event = $ctx->ok($bool, $name)
 
 =item $event = $ctx->ok($bool, $name, \@on_fail)
 
+B<NOTE:> Use of this method is discouraged in favor of C<pass()> and C<fail()>
+which produce L<Test2::Event::Pass> and L<Test2::Event::Fail> events. These
+newer event types are faster and less crufty.
+
 This will create an L<Test2::Event::Ok> object for you. If C<$bool> is false
 then an L<Test2::Event::Diag> event will be sent as well with details about the
 failure. If you do not want automatic diagnostics you should use the
 C<send_event()> method directly.
 
 The third argument C<\@on_fail>) is an optional set of diagnostics to be sent in
-the event of a test failure. Plain strings will be sent as
-L<Test2::Event::Diag> events. References will be used to construct
-L<Test2::Event::Info> events with C<< diagnostics => 1 >>.
-
-=item $event = $ctx->info($renderer, diagnostics => $bool, %other_params)
-
-Send an L<Test2::Event::Info>.
+the event of a test failure.
 
 =item $event = $ctx->note($message)
 
@@ -617,6 +755,22 @@ or
 This is the same as C<send_event()>, except it builds and returns the event
 without sending it.
 
+=item $event = $ctx->send_event_and_release($Type, %parameters)
+
+This is a combination of C<send_event()> and C<release()>.
+
+    sub shorthand {
+        my $ctx = context();
+        return $ctx->send_event_and_release(Pass => { name => 'foo' });
+    }
+
+    sub longform {
+        my $ctx = context();
+        my $event = $ctx->send_event(Pass => { name => 'foo' });
+        $ctx->release;
+        return $event;
+    }
+
 =back
 
 =head1 HOOKS
@@ -729,7 +883,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 70d4cd7..c971458 100644 (file)
@@ -2,16 +2,16 @@ package Test2::API::Instance;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
 use Carp qw/confess carp/;
 use Scalar::Util qw/reftype/;
 
-use Test2::Util qw/get_tid USE_THREADS CAN_FORK pkg_to_file try/;
+use Test2::Util qw/get_tid USE_THREADS CAN_FORK pkg_to_file try CAN_SIGSYS/;
 
-use Test2::Util::Trace();
+use Test2::EventFacet::Trace();
 use Test2::API::Stack();
 
 use Test2::Util::HashBase qw{
@@ -21,11 +21,14 @@ use Test2::Util::HashBase qw{
     ipc stack formatter
     contexts
 
+    -preload
+
     ipc_shm_size
     ipc_shm_last
     ipc_shm_id
     ipc_polling
     ipc_drivers
+    ipc_timeout
     formatters
 
     exit_callbacks
@@ -35,8 +38,10 @@ use Test2::Util::HashBase qw{
     context_release_callbacks
 };
 
-sub pid { $_[0]->{+_PID} ||= $$ }
-sub tid { $_[0]->{+_TID} ||= get_tid() }
+sub DEFAULT_IPC_TIMEOUT() { 30 }
+
+sub pid { $_[0]->{+_PID} }
+sub tid { $_[0]->{+_TID} }
 
 # Wrap around the getters that should call _finalize.
 BEGIN {
@@ -63,6 +68,46 @@ sub import {
 
 sub init { $_[0]->reset }
 
+sub start_preload {
+    my $self = shift;
+
+    confess "preload cannot be started, Test2::API has already been initialized"
+        if $self->{+FINALIZED} || $self->{+LOADED};
+
+    return $self->{+PRELOAD} = 1;
+}
+
+sub stop_preload {
+    my $self = shift;
+
+    return 0 unless $self->{+PRELOAD};
+    $self->{+PRELOAD} = 0;
+
+    $self->post_preload_reset();
+
+    return 1;
+}
+
+sub post_preload_reset {
+    my $self = shift;
+
+    delete $self->{+_PID};
+    delete $self->{+_TID};
+
+    $self->{+CONTEXTS} = {};
+
+    $self->{+FORMATTERS} = [];
+
+    $self->{+FINALIZED} = undef;
+    $self->{+IPC}       = undef;
+
+    $self->{+IPC_TIMEOUT} = DEFAULT_IPC_TIMEOUT() unless defined $self->{+IPC_TIMEOUT};
+
+    $self->{+LOADED} = 0;
+
+    $self->{+STACK} ||= Test2::API::Stack->new;
+}
+
 sub reset {
     my $self = shift;
 
@@ -80,6 +125,8 @@ sub reset {
     $self->{+FINALIZED} = undef;
     $self->{+IPC}       = undef;
 
+    $self->{+IPC_TIMEOUT} = DEFAULT_IPC_TIMEOUT() unless defined $self->{+IPC_TIMEOUT};
+
     $self->{+NO_WAIT} = 0;
     $self->{+LOADED}  = 0;
 
@@ -97,6 +144,9 @@ sub _finalize {
     my ($caller) = @_;
     $caller ||= [caller(1)];
 
+    confess "Attempt to initialize Test2::API during preload"
+        if $self->{+PRELOAD};
+
     $self->{+FINALIZED} = $caller;
 
     $self->{+_PID} = $$        unless defined $self->{+_PID};
@@ -227,6 +277,9 @@ sub add_post_load_callback {
 sub load {
     my $self = shift;
     unless ($self->{+LOADED}) {
+        confess "Attempt to initialize Test2::API during preload"
+            if $self->{+PRELOAD};
+
         $self->{+_PID} = $$        unless defined $self->{+_PID};
         $self->{+_TID} = get_tid() unless defined $self->{+_TID};
 
@@ -309,7 +362,7 @@ sub ipc_enable_shm {
         # In some systems (*BSD) accessing the SysV IPC APIs without
         # them being enabled can cause a SIGSYS.  We suppress the SIGSYS
         # and then get ENOSYS from the calls.
-        local $SIG{SYS} = 'IGNORE';
+        local $SIG{SYS} = 'IGNORE' if CAN_SIGSYS;
 
         require IPC::SysV;
 
@@ -367,41 +420,66 @@ sub disable_ipc_polling {
 }
 
 sub _ipc_wait {
+    my ($timeout) = @_;
     my $fail = 0;
 
-    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";
+    $timeout = DEFAULT_IPC_TIMEOUT() unless defined $timeout;
+
+    my $ok = eval {
+        if (CAN_FORK) {
+            local $SIG{ALRM} = sub { die "Timeout waiting on child processes" };
+            alarm $timeout;
+
+            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";
+            }
+
+            alarm 0;
         }
-    }
 
-    if (USE_THREADS) {
-        for my $t (threads->list()) {
-            $t->join;
-            # In older threads we cannot check if a thread had an error unless
-            # we control it and its return.
-            my $err = $t->can('error') ? $t->error : undef;
-            next unless $err;
-            my $tid = $t->tid();
-            $fail++;
-            chomp($err);
-            warn "Thread $tid did not end cleanly: $err\n";
+        if (USE_THREADS) {
+            my $start = time;
+
+            while (1) {
+                last unless threads->list();
+                die "Timeout waiting on child thread" if time - $start >= $timeout;
+                sleep 1;
+                for my $t (threads->list) {
+                    # threads older than 1.34 do not have this :-(
+                    next if $t->can('is_joinable') && !$t->is_joinable;
+                    $t->join;
+                    # In older threads we cannot check if a thread had an error unless
+                    # we control it and its return.
+                    my $err = $t->can('error') ? $t->error : undef;
+                    next unless $err;
+                    my $tid = $t->tid();
+                    $fail++;
+                    chomp($err);
+                    warn "Thread $tid did not end cleanly: $err\n";
+                }
+            }
         }
-    }
 
-    return 0 unless $fail;
+        1;
+    };
+    my $error = $@;
+
+    return 0 if $ok && !$fail;
+    warn $error unless $ok;
     return 255;
 }
 
 sub DESTROY {
     my $self = shift;
 
+    return if $self->{+PRELOAD};
+
     return unless defined($self->{+_PID}) && $self->{+_PID} == $$;
     return unless defined($self->{+_TID}) && $self->{+_TID} == get_tid();
 
@@ -412,6 +490,8 @@ sub DESTROY {
 sub set_exit {
     my $self = shift;
 
+    return if $self->{+PRELOAD};
+
     my $exit     = $?;
     my $new_exit = $exit;
 
@@ -470,13 +550,13 @@ This is not a supported configuration, you will have problems.
             $ipc->waiting();
         }
 
-        my $ipc_exit = _ipc_wait();
+        my $ipc_exit = _ipc_wait($self->{+IPC_TIMEOUT});
         $new_exit ||= $ipc_exit;
     }
 
     # None of this is necessary if we never got a root hub
     if(my $root = shift @hubs) {
-        my $trace = Test2::Util::Trace->new(
+        my $trace = Test2::EventFacet::Trace->new(
             frame  => [__PACKAGE__, __FILE__, 0, __PACKAGE__ . '::END'],
             detail => __PACKAGE__ . ' END Block finalization',
         );
@@ -645,6 +725,12 @@ pending events.
 
 When 1 is returned this will set C<< $obj->ipc_shm_last() >>.
 
+=item $timeout = $obj->ipc_timeout;
+
+=item $obj->set_ipc_timeout($timeout);
+
+How long to wait for child processes and threads before aborting.
+
 =item $drivers = $obj->ipc_drivers
 
 Get the list of IPC drivers.
@@ -744,7 +830,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 534cd78..d38563d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Stack;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Test2::Hub();
@@ -27,7 +27,7 @@ sub new_hub {
     }
     else {
         require Test2::API;
-        $hub->format(Test2::API::test2_formatter()->new)
+        $hub->format(Test2::API::test2_formatter()->new_root)
             unless $hub->format || exists($params{formatter});
 
         my $ipc = Test2::API::test2_ipc();
@@ -210,7 +210,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index a59a366..f7be152 100644 (file)
@@ -2,17 +2,47 @@ package Test2::Event;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
-use Test2::Util::HashBase qw/trace nested in_subtest subtest_id/;
+use Test2::Util::HashBase qw/trace -amnesty/;
 use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
 use Test2::Util qw(pkg_to_file);
-use Test2::Util::Trace;
+
+use Test2::EventFacet::About();
+use Test2::EventFacet::Amnesty();
+use Test2::EventFacet::Assert();
+use Test2::EventFacet::Control();
+use Test2::EventFacet::Error();
+use Test2::EventFacet::Info();
+use Test2::EventFacet::Meta();
+use Test2::EventFacet::Parent();
+use Test2::EventFacet::Plan();
+use Test2::EventFacet::Trace();
+
+my @FACET_TYPES = qw{
+    Test2::EventFacet::About
+    Test2::EventFacet::Amnesty
+    Test2::EventFacet::Assert
+    Test2::EventFacet::Control
+    Test2::EventFacet::Error
+    Test2::EventFacet::Info
+    Test2::EventFacet::Meta
+    Test2::EventFacet::Parent
+    Test2::EventFacet::Plan
+    Test2::EventFacet::Trace
+};
+
+sub FACET_TYPES() { @FACET_TYPES }
+
+# Legacy tools will expect this to be loaded now
+require Test2::Util::Trace;
+
 
 sub causes_fail      { 0 }
 sub increments_count { 0 }
 sub diagnostics      { 0 }
 sub no_display       { 0 }
+sub subtest_id       { undef }
 
 sub callback { }
 
@@ -22,31 +52,152 @@ sub sets_plan { () }
 
 sub summary { ref($_[0]) }
 
-sub from_json {
-    my $class = shift;
-       my %p     = @_;
+sub related {
+    my $self = shift;
+    my ($event) = @_;
+
+    my $tracea = $self->trace  or return undef;
+    my $traceb = $event->trace or return undef;
+
+    my $siga = $tracea->signature or return undef;
+    my $sigb = $traceb->signature or return undef;
+
+    return 1 if $siga eq $sigb;
+    return 0;
+}
+
+sub add_amnesty {
+    my $self = shift;
+
+    for my $am (@_) {
+        $am = {%$am} if ref($am) ne 'ARRAY';
+        $am = Test2::EventFacet::Amnesty->new($am);
 
-    my $event_pkg = delete $p{__PACKAGE__};
-       require(pkg_to_file($event_pkg));
+        push @{$self->{+AMNESTY}} => $am;
+    }
+}
+
+sub common_facet_data {
+    my $self = shift;
+
+    my %out;
+
+    $out{about} = {package => ref($self) || undef};
+
+    if (my $trace = $self->trace) {
+        $out{trace} = { %$trace };
+    }
+
+    $out{amnesty} = [map {{ %{$_} }} @{$self->{+AMNESTY}}]
+        if $self->{+AMNESTY};
+
+    my $key = Test2::Util::ExternalMeta::META_KEY();
+    if (my $hash = $self->{$key}) {
+        $out{meta} = {%$hash};
+    }
+
+    return \%out;
+}
+
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    $out->{about}->{details}    = $self->summary    || undef;
+    $out->{about}->{no_display} = $self->no_display || undef;
+
+    # Might be undef, we want to preserve that
+    my $terminate = $self->terminate;
+    $out->{control} = {
+        global    => $self->global    || 0,
+        terminate => $terminate,
+        has_callback => $self->can('callback') == \&callback ? 0 : 1,
+    };
+
+    $out->{assert} = {
+        no_debug => 1,                     # Legacy behavior
+        pass     => $self->causes_fail ? 0 : 1,
+        details  => $self->summary,
+    } if $self->increments_count;
+
+    $out->{parent} = {hid => $self->subtest_id} if $self->subtest_id;
+
+    if (my @plan = $self->sets_plan) {
+        $out->{plan} = {};
+
+        $out->{plan}->{count}   = $plan[0] if defined $plan[0];
+        $out->{plan}->{details} = $plan[2] if defined $plan[2];
+
+        if ($plan[1]) {
+            $out->{plan}->{skip} = 1 if $plan[1] eq 'SKIP';
+            $out->{plan}->{none} = 1 if $plan[1] eq 'NO PLAN';
+        }
+
+        $out->{control}->{terminate} ||= 0 if $out->{plan}->{skip};
+    }
 
-       if (exists $p{trace}) {
-               $p{trace} = Test2::Util::Trace->from_json(%{$p{trace}});
-       }
+    if ($self->causes_fail && !$out->{assert}) {
+        $out->{errors} = [
+            {
+                tag     => 'FAIL',
+                fail    => 1,
+                details => $self->summary,
+            }
+        ];
+    }
 
-       if (exists $p{subevents}) {
-               my @subevents;
-               for my $subevent (@{delete $p{subevents} || []}) {
-                       push @subevents, Test2::Event->from_json(%$subevent);
-               }
-               $p{subevents} = \@subevents;
-       }
+    my %IGNORE = (trace => 1, about => 1, control => 1);
+    my $do_info = !grep { !$IGNORE{$_} } keys %$out;
+
+    if ($do_info && !$self->no_display && $self->diagnostics) {
+        $out->{info} = [
+            {
+                tag     => 'DIAG',
+                debug   => 1,
+                details => $self->summary,
+            }
+        ];
+    }
 
-    return $event_pkg->new(%p);
+    return $out;
 }
 
-sub TO_JSON {
+sub facets {
     my $self = shift;
-    return {%$self, __PACKAGE__ => ref $self};
+    my $data = $self->facet_data;
+    my %out;
+
+    for my $type (FACET_TYPES()) {
+        my $key = $type->facet_key;
+        next unless $data->{$key};
+
+        if ($type->is_list) {
+            $out{$key} = [map { $type->new($_) } @{$data->{$key}}];
+        }
+        else {
+            $out{$key} = $type->new($data->{$key});
+        }
+    }
+
+    return \%out;
+}
+
+sub nested {
+    Carp::cluck("Use of Test2::Event->nested() is deprecated, use Test2::Event->trace->nested instead")
+        if $ENV{AUTHOR_TESTING};
+
+    $_[0]->{+TRACE}->{nested};
+}
+
+sub in_subtest {
+    Carp::cluck("Use of Test2::Event->in_subtest() is deprecated, use Test2::Event->trace->hid instead")
+        if $ENV{AUTHOR_TESTING};
+
+    # Return undef if we are not nested, Legacy did not return the hid if nestign was 0.
+    return undef unless $_[0]->{+TRACE}->{nested};
+
+    $_[0]->{+TRACE}->{hid};
 }
 
 1;
@@ -80,6 +231,10 @@ L<Test2>.
     # want, or roll your own accessors.
     use Test2::Util::HashBase qw/foo bar baz/;
 
+    # Use this if you want the legacy API to be written for you, for this to
+    # work you will need to implement a facet_data() method.
+    use Test2::Util::Facets2Legacy;
+
     # Chance to initialize some defaults
     sub init {
         my $self = shift;
@@ -90,17 +245,232 @@ L<Test2>.
         ...
     }
 
+    # This is the new way for events to convey data to the Test2 system
+    sub facet_data {
+        my $self = shift;
+
+        # Get common facets such as 'about', 'trace' 'amnesty', and 'meta'
+        my $facet_data = $self->common_facet_data();
+
+        # Are you making an assertion?
+        $facet_data->{assert} = {pass => 1, details => 'my assertion'};
+        ...
+
+        return $facet_data;
+    }
+
     1;
 
 =head1 METHODS
 
+=head2 GENERAL
+
 =over 4
 
 =item $trace = $e->trace
 
-Get a snapshot of the L<Test2::Util::Trace> as it was when this event was
+Get a snapshot of the L<Test2::EventFacet::Trace> as it was when this event was
 generated
 
+=item $bool_or_undef = $e->related($e2)
+
+Check if 2 events are related. In this case related means their traces share a
+signature meaning they were created with the same context (or at the very least
+by contexts which share an id, which is the same thing unless someone is doing
+something very bad).
+
+This can be used to reliably link multiple events created by the same tool. For
+instance a failing test like C<ok(0, "fail"> will generate 2 events, one being
+a L<Test2::Event::Ok>, the other being a L<Test2::Event::Diag>, both of these
+events are related having been created under the same context and by the same
+initial tool (though multiple tools may have been nested under the initial
+one).
+
+This will return C<undef> if the relationship cannot be checked, which happens
+if either event has an incomplete or missing trace. This will return C<0> if
+the traces are complete, but do not match. C<1> will be returned if there is a
+match.
+
+=item $e->add_amnesty({tag => $TAG, details => $DETAILS});
+
+This can be used to add amnesty to this event. Amnesty only effects failing
+assertions in most cases, but some formatters may display them for passing
+assertions, or even non-assertions as well.
+
+Amnesty will prevent a failed assertion from causing the overall test to fail.
+In other words it marks a failure as expected and allowed.
+
+B<Note:> This is how 'TODO' is implemented under the hood. TODO is essentially
+amnesty with the 'TODO' tag. The details are the reason for the TODO.
+
+=back
+
+=head2 NEW API
+
+=over 4
+
+=item $hashref = $e->common_facet_data();
+
+This can be used by subclasses to generate a starting facet data hashref. This
+will populate the hashref with the trace, meta, amnesty, and about facets.
+These facets are nearly always produced the same way for all events.
+
+=item $hashref = $e->facet_data()
+
+If you do not override this then the default implementation will attempt to
+generate facets from the legacy API. This generation is limited only to what
+the legacy API can provide. It is recommended that you override this method and
+write out explicit facet data.
+
+=item $hashref = $e->facets()
+
+This takes the hashref from C<facet_data()> and blesses each facet into the
+proper C<Test2::EventFacet::*> subclass.
+
+=back
+
+=head3 WHAT ARE FACETS?
+
+Facets are how events convey their purpose to the Test2 internals and
+formatters. An event without facets will have no intentional effect on the
+overall test state, and will not be displayed at all by most formatters, except
+perhaps to say that an event of an unknown type was seen.
+
+Facets are produced by the C<facet_data()> subroutine, which you should
+nearly-always override. C<facet_data()> is expected to return a hashref where
+each key is the facet type, and the value is either a hashref with the data for
+that facet, or an array of hashref's. Some facets must be defined as single
+hashrefs, some must be defined as an array of hashrefs, No facets allow both.
+
+C<facet_data()> B<MUST NOT> bless the data it returns, the main hashref, and
+nested facet hashref's B<MUST> be bare, though items contained within each
+facet may be blessed. The data returned by this method B<should> also be copies
+of the internal data in order to prevent accidental state modification.
+
+C<facets()> takes the data from C<facet_data()> and blesses it into the
+C<Test2::EventFacet::*> packages. This is rarely used however, the EventFacet
+packages are primarily for convenience and documentation. The EventFacet
+classes are not used at all internally, instead the raw data is used.
+
+Here is a list of facet types by package. The packages are not used internally,
+but are where the documentation for each type is kept.
+
+B<Note:> Every single facet type has the C<'details'> field. This field is
+always intended for human consumption, and when provided, should explain the
+'why' for the facet. All other fields are facet specific.
+
+=over 4
+
+=item about => {...}
+
+L<Test2::EventFacet::About>
+
+This contains information about the event itself such as the event package
+name. The C<details> field for this facet is an overall summary of the event.
+
+=item assert => {...}
+
+L<Test2::EventFacet::Assert>
+
+This facet is used if an assertion was made. The C<details> field of this facet
+is the description of the assertion.
+
+=item control => {...}
+
+L<Test2::EventFacet::Control>
+
+This facet is used to tell the L<Test2::Event::Hub> about special actions the
+event causes. Things like halting all testing, terminating the current test,
+etc. In this facet the C<details> field explains why any special action was
+taken.
+
+B<Note:> This is how bail-out is implemented.
+
+=item meta => {...}
+
+L<Test2::EventFacet::Meta>
+
+The meta facet contains all the meta-data attached to the event. In this case
+the C<details> field has no special meaning, but may be present if something
+sets the 'details' meta-key on the event.
+
+=item parent => {...}
+
+L<Test2::EventFacet::Parent>
+
+This facet contains nested events and similar details for subtests. In this
+facet the C<details> field will typically be the name of the subtest.
+
+=item plan => {...}
+
+L<Test2::EventFacet::Plan>
+
+This facet tells the system that a plan has been set. The C<details> field of
+this is usually left empty, but when present explains why the plan is what it
+is, this is most useful if the plan is to skip-all.
+
+=item trace => {...}
+
+L<Test2::EventFacet::Trace>
+
+This facet contains information related to when and where the event was
+generated. This is how the test file and line number of a failure is known.
+This facet can also help you to tell if tests are related.
+
+In this facet the C<details> field overrides the "failed at test_file.t line
+42." message provided on assertion failure.
+
+=item amnesty => [{...}, ...]
+
+L<Test2::EventFacet::Amnesty>
+
+The amnesty facet is a list instead of a single item, this is important as
+amnesty can come from multiple places at once.
+
+For each instance of amnesty the C<details> field explains why amnesty was
+granted.
+
+B<Note:> Outside of formatters amnesty only acts to forgive a failing
+assertion.
+
+=item errors => [{...}, ...]
+
+L<Test2::EventFacet::Error>
+
+The errors facet is a list instead of a single item, any number of errors can
+be listed. In this facet C<details> describes the error, or may contain the raw
+error message itself (such as an exception). In perl exception may be blessed
+objects, as such the raw data for this facet may contain nested items which are
+blessed.
+
+Not all errors are considered fatal, there is a C<fail> field that must be set
+for an error to cause the test to fail.
+
+B<Note:> This facet is unique in that the field name is 'errors' while the
+package is 'Error'. This is because this is the only facet type that is both a
+list, and has a name where the plural is not the same as the singular. This may
+cause some confusion, but I feel it will be less confusing than the
+alternative.
+
+=item info => [{...}, ...]
+
+L<Test2::EventFacet::Info>
+
+The 'info' facet is a list instead of a single item, any quantity of extra
+information can be attached to an event. Some information may be critical
+diagnostics, others may be simply commentary in nature, this is determined by
+the C<debug> flag.
+
+For this facet the C<details> flag is the info itself. This info may be a
+string, or it may be a data structure to display. This is one of the few facet
+types that may contain blessed items.
+
+=back
+
+=head2 LEGACY API
+
+=over 4
+
 =item $bool = $e->causes_fail
 
 Returns true if this event should result in a test failure. In general this
@@ -117,11 +487,6 @@ this method.
 
 This is called B<BEFORE> your event is passed to the formatter.
 
-=item $call = $e->created
-
-Get the C<caller()> details from when the event was generated. This is usually
-inside a tools package. This is typically used for debugging.
-
 =item $num = $e->nested
 
 If this event is nested inside of other events, this should be the depth of
@@ -150,23 +515,6 @@ to exit with a failure.
 This is called after the event has been sent to the formatter in order to
 ensure the event is seen and understood.
 
-=item $todo = $e->todo
-
-=item $e->set_todo($todo)
-
-Get/Set the todo reason on the event. Any value other than C<undef> makes the
-event 'TODO'.
-
-Not all events make use of this field, but they can all have it set/cleared.
-
-=item $bool = $e->diag_todo
-
-=item $e->diag_todo($todo)
-
-True if this event should be considered 'TODO' for diagnostics purposes. This
-essentially means that any message that would go to STDERR will go to STDOUT
-instead so that a harness will hide it outside of verbose mode.
-
 =item $msg = $e->summary
 
 This is intended to be a human readable summary of the event. This should
@@ -202,17 +550,6 @@ If the event is inside a subtest this should have the subtest ID.
 
 If the event is a final subtest event, this should contain the subtest ID.
 
-=item $hashref = $e->TO_JSON
-
-This returns a hashref suitable for passing to the C<< Test2::Event->from_json
->> constructor. It is intended for use with the L<JSON> family of modules,
-which will look for a C<TO_JSON> method when C<convert_blessed> is true.
-
-=item $e = Test2::Event->from_json(%$hashref)
-
-Given the hash of data returned by C<< $e->TO_JSON >>, this method returns a
-new event object of the appropriate subclass.
-
 =back
 
 =head1 THIRD PARTY META-DATA
@@ -244,7 +581,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 0284aec..bd1dda9 100644 (file)
@@ -2,18 +2,11 @@ package Test2::Event::Bail;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
-use Test2::Util::HashBase qw{reason};
-
-sub callback {
-    my $self = shift;
-    my ($hub) = @_;
-
-    $hub->set_bailed_out($self);
-}
+use Test2::Util::HashBase qw{reason buffered};
 
 # Make sure the tests terminate
 sub terminate { 255 };
@@ -32,6 +25,20 @@ sub summary {
 
 sub diagnostics { 1 }
 
+sub facet_data {
+    my $self = shift;
+    my $out = $self->common_facet_data;
+
+    $out->{control} = {
+        global    => 1,
+        halt      => 1,
+        details   => $self->{+REASON},
+        terminate => 255,
+    };
+
+    return $out;
+}
+
 1;
 
 __END__
@@ -92,7 +99,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 9d2ba88..974a203 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Diag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -16,6 +16,22 @@ sub summary { $_[0]->{+MESSAGE} }
 
 sub diagnostics { 1 }
 
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    $out->{info} = [
+        {
+            tag     => 'DIAG',
+            debug   => 1,
+            details => $self->{+MESSAGE},
+        }
+    ];
+
+    return $out;
+}
+
 1;
 
 __END__
@@ -73,7 +89,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 52af3f2..78f8aa2 100644 (file)
@@ -2,18 +2,29 @@ package Test2::Event::Encoding;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
+
+use Carp qw/croak/;
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
 use Test2::Util::HashBase qw/encoding/;
 
 sub init {
     my $self = shift;
-    defined $self->{+ENCODING} or $self->trace->throw("'encoding' is a required attribute");
+    defined $self->{+ENCODING} or croak "'encoding' is a required attribute";
 }
 
 sub summary { 'Encoding set to ' . $_[0]->{+ENCODING} }
 
+sub facet_data {
+    my $self = shift;
+    my $out = $self->common_facet_data;
+    $out->{control}->{encoding} = $self->{+ENCODING};
+    $out->{about}->{details} = $self->summary;
+    return $out;
+}
+
+
 1;
 
 __END__
@@ -76,7 +87,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index a10ca67..4ef3916 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Exception;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -18,6 +18,22 @@ sub summary {
 
 sub diagnostics { 1 }
 
+sub facet_data {
+    my $self = shift;
+    my $out = $self->common_facet_data;
+
+    $out->{errors} = [
+        {
+            tag     => 'ERROR',
+            fail    => 1,
+            details => $self->{+ERROR},
+        }
+    ];
+
+    return $out;
+}
+
+
 1;
 
 __END__
@@ -78,7 +94,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
diff --git a/cpan/Test-Simple/lib/Test2/Event/Fail.pm b/cpan/Test-Simple/lib/Test2/Event/Fail.pm
new file mode 100644 (file)
index 0000000..f298bc5
--- /dev/null
@@ -0,0 +1,118 @@
+package Test2::Event::Fail;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+use Test2::EventFacet::Info;
+
+BEGIN {
+    require Test2::Event;
+    our @ISA = qw(Test2::Event);
+    *META_KEY = \&Test2::Util::ExternalMeta::META_KEY;
+}
+
+use Test2::Util::HashBase qw{ -name -info };
+
+#############
+# Old API
+sub summary          { "fail" }
+sub increments_count { 1 }
+sub diagnostics      { 0 }
+sub no_display       { 0 }
+sub subtest_id       { undef }
+sub terminate        { () }
+sub global           { () }
+sub sets_plan        { () }
+
+sub causes_fail {
+    my $self = shift;
+    return 0 if $self->{+AMNESTY} && @{$self->{+AMNESTY}};
+    return 1;
+}
+
+#############
+# New API
+
+sub add_info {
+    my $self = shift;
+
+    for my $in (@_) {
+        $in = {%$in} if ref($in) ne 'ARRAY';
+        $in = Test2::EventFacet::Info->new($in);
+
+        push @{$self->{+INFO}} => $in;
+    }
+}
+
+sub facet_data {
+    my $self = shift;
+    my $out = $self->common_facet_data;
+
+    $out->{about}->{details} = 'fail';
+
+    $out->{assert} = {pass => 0, details => $self->{+NAME}};
+
+    $out->{info} = [map {{ %{$_} }} @{$self->{+INFO}}] if $self->{+INFO};
+
+    return $out;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Fail - Event for a simple failed assertion
+
+=head1 DESCRIPTION
+
+This is an optimal representation of a failed assertion.
+
+=head1 SYNOPSIS
+
+    use Test2::API qw/context/;
+
+    sub fail {
+        my ($name) = @_;
+        my $ctx = context();
+        $ctx->fail($name);
+        $ctx->release;
+    }
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
index ad00f5a..04611a6 100644 (file)
@@ -5,14 +5,14 @@ use warnings;
 use Carp qw/croak/;
 use Scalar::Util qw/reftype/;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
 use Test2::Util::HashBase;
 
 my @FIELDS = qw{
     causes_fail increments_count diagnostics no_display callback terminate
-    global sets_plan summary
+    global sets_plan summary facet_data
 };
 my %DEFAULTS = (
     causes_fail      => 0,
@@ -35,15 +35,24 @@ sub init {
 
 for my $field (@FIELDS) {
     no strict 'refs';
-    my $stash = \%{__PACKAGE__ . "::"};
 
     *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () }
-        unless defined $stash->{$field}
-            && defined *{$stash->{$field}}{CODE};
+        unless exists &{$field};
 
     *{"set_$field"} = sub { $_[0]->{$field} = $_[1] }
-        unless defined $stash->{"set_$field"}
-            && defined *{$stash->{"set_$field"}}{CODE};
+        unless exists &{"set_$field"};
+}
+
+sub can {
+    my $self = shift;
+    my ($name) = @_;
+    return $self->SUPER::can($name) unless $name eq 'callback';
+    return $self->{callback} || \&Test2::Event::callback;
+}
+
+sub facet_data {
+    my $self = shift;
+    return $self->{facet_data} || $self->SUPER::facet_data();
 }
 
 sub summary {
@@ -157,6 +166,14 @@ a published reusable event subclass.
 
 =over 4
 
+=item $e->facet_data($data)
+
+=item $data = $e->facet_data
+
+Get or set the facet data (see L<Test2::Event>). If no facet_data is set then
+C<< Test2::Event->facet_data >> will be called to produce facets from the other
+data.
+
 =item $e->callback($hub)
 
 Call the custom callback if one is set, otherwise this does nothing.
@@ -253,7 +270,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
diff --git a/cpan/Test-Simple/lib/Test2/Event/Info.pm b/cpan/Test-Simple/lib/Test2/Event/Info.pm
deleted file mode 100644 (file)
index 51c4bbc..0000000
+++ /dev/null
@@ -1,127 +0,0 @@
-package Test2::Event::Info;
-use strict;
-use warnings;
-
-use Scalar::Util qw/blessed/;
-
-our $VERSION = '1.302073';
-
-BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
-use Test2::Util::HashBase qw/diagnostics renderer/;
-
-sub init {
-    my $self = shift;
-
-    my $r = $self->{+RENDERER} or $self->trace->throw("'renderer' is a required attribute");
-
-    return if ref($r) eq 'CODE';
-    return if blessed($r) && $r->can('render');
-
-    $self->trace->throw("renderer '$r' is not a valid renderer, must be a coderef or an object implementing the 'render()' method");
-}
-
-sub render {
-    my $self = shift;
-    my ($fmt) = @_;
-
-    $fmt ||= 'text';
-
-    my $r = $self->{+RENDERER};
-
-    return $r->($fmt) if ref($r) eq 'CODE';
-    return $r->render($fmt);
-}
-
-sub summary { $_[0]->render($_[1] || 'text') }
-
-1;
-
-__END__
-
-=pod
-
-=encoding UTF-8
-
-=head1 NAME
-
-Test2::Event::Info - Info event base class
-
-=head1 DESCRIPTION
-
-Successor for note and diag events. This event base class supports multiple
-formats. This event makes it possible to send additional information such as
-color and highlighting to the harness.
-
-=head1 SYNOPSIS
-
-    use Test2::API::Context qw/context/;
-
-    $ctx->info($obj, diagnostics => $bool);
-
-=head1 FORMATS
-
-Format will be passed in to C<render()> and C<summary()> as a string. Any
-string is considered valid, if your event does not recognize the format it
-should fallback to 'text'.
-
-=over 4
-
-=item 'text'
-
-Plain and ordinary text.
-
-=item 'ansi'
-
-Text that may include ansi sequences such as colors.
-
-=item 'html'
-
-HTML formatted text.
-
-=back
-
-=head1 ACCESSORS
-
-=over 4
-
-=item $bool = $info->diagnostics()
-
-=item $info->set_diagnostics($bool)
-
-True if this info is essential for diagnostics. The implication is that
-diagnostics will got to STDERR while everything else goes to STDOUT, but that
-is formatter/harness specific.
-
-=back
-
-=head1 SOURCE
-
-The source code repository for Test2 can be found at
-F<http://github.com/Test-More/test-more/>.
-
-=head1 MAINTAINERS
-
-=over 4
-
-=item Chad Granum E<lt>exodist@cpan.orgE<gt>
-
-=back
-
-=head1 AUTHORS
-
-=over 4
-
-=item Chad Granum E<lt>exodist@cpan.orgE<gt>
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See F<http://dev.perl.org/licenses/>
-
-=cut
index b9a2ded..35e4be7 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Note;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -14,6 +14,22 @@ sub init {
 
 sub summary { $_[0]->{+MESSAGE} }
 
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    $out->{info} = [
+        {
+            tag     => 'NOTE',
+            debug   => 0,
+            details => $self->{+MESSAGE},
+        }
+    ];
+
+    return $out;
+}
+
 1;
 
 __END__
@@ -71,7 +87,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 456d6bb..5cc02d2 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Ok;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -48,6 +48,33 @@ sub summary {
     return $name;
 }
 
+sub extra_amnesty {
+    my $self = shift;
+    return unless defined($self->{+TODO}) || ($self->{+EFFECTIVE_PASS} && !$self->{+PASS});
+    return {
+        tag       => 'TODO',
+        details   => $self->{+TODO},
+    };
+}
+
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    $out->{assert}  = {
+        no_debug => 1,                # Legacy behavior
+        pass     => $self->{+PASS},
+        details  => $self->{+NAME},
+    };
+
+    if (my @exra_amnesty = $self->extra_amnesty) {
+        unshift @{$out->{amnesty}} => @exra_amnesty;
+    }
+
+    return $out;
+}
+
 1;
 
 __END__
@@ -100,11 +127,6 @@ Name of the test.
 This is the true/false value of the test after TODO and similar modifiers are
 taken into account.
 
-=item $b = $e->allow_bad_name
-
-This relaxes the test name checks such that they allow characters that can
-confuse a TAP parser.
-
 =back
 
 =head1 SOURCE
@@ -130,7 +152,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
diff --git a/cpan/Test-Simple/lib/Test2/Event/Pass.pm b/cpan/Test-Simple/lib/Test2/Event/Pass.pm
new file mode 100644 (file)
index 0000000..a3e91e4
--- /dev/null
@@ -0,0 +1,114 @@
+package Test2::Event::Pass;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+use Test2::EventFacet::Info;
+
+BEGIN {
+    require Test2::Event;
+    our @ISA = qw(Test2::Event);
+    *META_KEY = \&Test2::Util::ExternalMeta::META_KEY;
+}
+
+use Test2::Util::HashBase qw{ -name -info };
+
+##############
+# Old API
+sub summary          { "pass" }
+sub increments_count { 1 }
+sub causes_fail      { 0 }
+sub diagnostics      { 0 }
+sub no_display       { 0 }
+sub subtest_id       { undef }
+sub terminate        { () }
+sub global           { () }
+sub sets_plan        { () }
+
+##############
+# New API
+
+sub add_info {
+    my $self = shift;
+
+    for my $in (@_) {
+        $in = {%$in} if ref($in) ne 'ARRAY';
+        $in = Test2::EventFacet::Info->new($in);
+
+        push @{$self->{+INFO}} => $in;
+    }
+}
+
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    $out->{about}->{details} = 'pass';
+
+    $out->{assert} = {pass => 1, details => $self->{+NAME}};
+
+    $out->{info} = [map {{ %{$_} }} @{$self->{+INFO}}] if $self->{+INFO};
+
+    return $out;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Pass - Event for a simple passing assertion
+
+=head1 DESCRIPTION
+
+This is an optimal representation of a passing assertion.
+
+=head1 SYNOPSIS
+
+    use Test2::API qw/context/;
+
+    sub pass {
+        my ($name) = @_;
+        my $ctx = context();
+        $ctx->pass($name);
+        $ctx->release;
+    }
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
index 94b3030..3a647a5 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Plan;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -46,17 +46,6 @@ sub sets_plan {
     );
 }
 
-sub callback {
-    my $self = shift;
-    my ($hub) = @_;
-
-    $hub->plan($self->{+DIRECTIVE} || $self->{+MAX});
-
-    return unless $self->{+DIRECTIVE};
-
-    $hub->set_skip_reason($self->{+REASON} || 1) if $self->{+DIRECTIVE} eq 'SKIP';
-}
-
 sub terminate {
     my $self = shift;
     # On skip_all we want to terminate the hub
@@ -79,6 +68,26 @@ sub summary {
     return "Plan is '$directive'";
 }
 
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    $out->{control}->{terminate} = $self->{+DIRECTIVE} eq 'SKIP' ? 0 : undef
+        unless defined $out->{control}->{terminate};
+
+    $out->{plan} = {count => $self->{+MAX}};
+    $out->{plan}->{details} = $self->{+REASON} if defined $self->{+REASON};
+
+    if (my $dir = $self->{+DIRECTIVE}) {
+        $out->{plan}->{skip} = 1 if $dir eq 'SKIP';
+        $out->{plan}->{none} = 1 if $dir eq 'NO PLAN';
+    }
+
+    return $out;
+}
+
+
 1;
 
 __END__
@@ -150,7 +159,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 7cca061..69c5719 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Skip;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
@@ -30,6 +30,25 @@ sub summary {
     return $out;
 }
 
+sub extra_amnesty {
+    my $self = shift;
+
+    my @out;
+
+    push @out => {
+        tag       => 'TODO',
+        details   => $self->{+TODO},
+    } if defined $self->{+TODO};
+
+    push @out => {
+        tag       => 'skip',
+        details   => $self->{+REASON},
+        inherited => 0,
+    };
+
+    return @out;
+}
+
 1;
 
 __END__
@@ -98,7 +117,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 2b3c773..56c4c07 100644 (file)
@@ -2,50 +2,49 @@ package Test2::Event::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
-
+our $VERSION = '1.302096';
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
 use Test2::Util::HashBase qw{subevents buffered subtest_id};
 
 sub init {
-       my $self = shift;
-       $self->SUPER::init();
-       $self->{+SUBEVENTS} ||= [];
-       if ($self->{+EFFECTIVE_PASS}) {
-               $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}};
-       }
+    my $self = shift;
+    $self->SUPER::init();
+    $self->{+SUBEVENTS} ||= [];
+    if ($self->{+EFFECTIVE_PASS}) {
+        $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}};
+    }
 }
 
 {
-       no warnings 'redefine';
-
-       sub set_subevents {
-               my $self      = shift;
-               my @subevents = @_;
-
-               if ($self->{+EFFECTIVE_PASS}) {
-                       $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @subevents;
-               }
-
-               $self->{+SUBEVENTS} = \@subevents;
-       }
-
-       sub set_effective_pass {
-               my $self = shift;
-               my ($pass) = @_;
-
-               if ($pass) {
-                       $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}};
-               }
-               elsif ($self->{+EFFECTIVE_PASS} && !$pass) {
-                       for my $s (grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}}) {
-                               $_->set_effective_pass(0) unless $s->can('todo') && defined $s->todo;
-                       }
-               }
-
-               $self->{+EFFECTIVE_PASS} = $pass;
-       }
+    no warnings 'redefine';
+
+    sub set_subevents {
+        my $self      = shift;
+        my @subevents = @_;
+
+        if ($self->{+EFFECTIVE_PASS}) {
+            $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @subevents;
+        }
+
+        $self->{+SUBEVENTS} = \@subevents;
+    }
+
+    sub set_effective_pass {
+        my $self = shift;
+        my ($pass) = @_;
+
+        if ($pass) {
+            $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}};
+        }
+        elsif ($self->{+EFFECTIVE_PASS} && !$pass) {
+            for my $s (grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}}) {
+                $_->set_effective_pass(0) unless $s->can('todo') && defined $s->todo;
+            }
+        }
+
+        $self->{+EFFECTIVE_PASS} = $pass;
+    }
 }
 
 sub summary {
@@ -58,12 +57,42 @@ sub summary {
         $name .= " (TODO: $todo)";
     }
     elsif (defined $todo) {
-        $name .= " (TODO)"
+        $name .= " (TODO)";
     }
 
     return $name;
 }
 
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->SUPER::facet_data();
+
+    $out->{parent} = {
+        hid      => $self->subtest_id,
+        children => [map {$_->facet_data} @{$self->{+SUBEVENTS}}],
+        buffered => $self->{+BUFFERED},
+    };
+
+    return $out;
+}
+
+sub add_amnesty {
+    my $self = shift;
+
+    for my $am (@_) {
+        $am = {%$am} if ref($am) ne 'ARRAY';
+        $am = Test2::EventFacet::Amnesty->new($am);
+
+        push @{$self->{+AMNESTY}} => $am;
+
+        for my $e (@{$self->{+SUBEVENTS}}) {
+            $e->add_amnesty($am->clone(inherited => 1));
+        }
+    }
+}
+
+
 1;
 
 __END__
@@ -121,7 +150,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index b96a25a..bd539f9 100644 (file)
@@ -2,18 +2,36 @@ package Test2::Event::TAP::Version;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
+
+use Carp qw/croak/;
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
 use Test2::Util::HashBase qw/version/;
 
 sub init {
     my $self = shift;
-    defined $self->{+VERSION} or $self->trace->throw("'version' is a required attribute");
+    defined $self->{+VERSION} or croak "'version' is a required attribute";
 }
 
 sub summary { 'TAP version ' . $_[0]->{+VERSION} }
 
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    $out->{about}->{details} = $self->summary;
+
+    push @{$out->{info}} => {
+        tag     => 'INFO',
+        debug   => 0,
+        details => $self->summary,
+    };
+
+    return $out;
+}
+
 1;
 
 __END__
@@ -73,7 +91,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index fa87c6e..bdf8fde 100644 (file)
@@ -2,15 +2,30 @@ package Test2::Event::Waiting;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase;
 
 sub global { 1 };
 
 sub summary { "IPC is waiting for children to finish..." }
 
+sub facet_data {
+    my $self = shift;
+
+    my $out = $self->common_facet_data;
+
+    push @{$out->{info}} => {
+        tag     => 'INFO',
+        debug   => 0,
+        details => $self->summary,
+    };
+
+    return $out;
+}
+
 1;
 
 __END__
@@ -51,7 +66,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet.pm b/cpan/Test-Simple/lib/Test2/EventFacet.pm
new file mode 100644 (file)
index 0000000..794c454
--- /dev/null
@@ -0,0 +1,93 @@
+package Test2::EventFacet;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+use Test2::Util::HashBase qw/-details/;
+use Carp qw/croak/;
+
+my $SUBLEN = length(__PACKAGE__ . '::');
+sub facet_key {
+    my $key = ref($_[0]) || $_[0];
+    substr($key, 0, $SUBLEN, '');
+    return lc($key);
+}
+
+sub is_list { 0 }
+
+sub clone {
+    my $self = shift;
+    my $type = ref($self);
+    return bless {%$self, @_}, $type;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet - Base class for all event facets.
+
+=head1 DESCRIPTION
+
+Base class for all event facets.
+
+=head1 METHODS
+
+=over 4
+
+=item $key = $facet_class->facet_key()
+
+This will return the key for the facet in the facet data hash.
+
+=item $bool = $facet_class->is_list()
+
+This will return true if the facet should be in a list instead of a single
+item.
+
+=item $clone = $facet->clone()
+
+=item $clone = $facet->clone(%replace)
+
+This will make a shallow clone of the facet. You may specify fields to override
+as arguments.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/About.pm b/cpan/Test-Simple/lib/Test2/EventFacet/About.pm
new file mode 100644 (file)
index 0000000..58000d3
--- /dev/null
@@ -0,0 +1,80 @@
+package Test2::EventFacet::About;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{ -package -no_display };
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::About - Facet with event details.
+
+=head1 DESCRIPTION
+
+This facet has information about the event, such as event package.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string = $about->{details}
+
+=item $string = $about->details()
+
+Summary about the event.
+
+=item $package = $about->{package}
+
+=item $package = $about->package()
+
+Event package name.
+
+=item $bool = $about->{no_display}
+
+=item $bool = $about->no_display()
+
+True if the event should be skipped by formatters.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm
new file mode 100644 (file)
index 0000000..409a9e3
--- /dev/null
@@ -0,0 +1,91 @@
+package Test2::EventFacet::Amnesty;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+sub is_list { 1 }
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{ -tag -inherited };
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Amnesty - Facet for assertion amnesty.
+
+=head1 DESCRIPTION
+
+This package represents what is expected in units of amnesty.
+
+=head1 NOTES
+
+This facet appears in a list instead of being a single item.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string = $amnesty->{details}
+
+=item $string = $amnesty->details()
+
+Human readable explanation of why amnesty was granted.
+
+Example: I<Not implemented yet, will fix>
+
+=item $short_string = $amnesty->{tag}
+
+=item $short_string = $amnesty->tag()
+
+Short string (usually 10 characters or less, not enforced, but may be truncated
+by renderers) categorizing the amnesty.
+
+=item $bool = $amnesty->{inherited}
+
+=item $bool = $amnesty->inherited()
+
+This will be true if the amnesty was granted to a parent event and inherited by
+this event, which is a child, such as an assertion within a subtest that is
+marked todo.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm
new file mode 100644 (file)
index 0000000..d42677f
--- /dev/null
@@ -0,0 +1,93 @@
+package Test2::EventFacet::Assert;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{ -pass -no_debug -number };
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Assert - Facet representing an assertion.
+
+=head1 DESCRIPTION
+
+The assertion facet is provided by any event representing an assertion that was
+made.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string = $assert->{details}
+
+=item $string = $assert->details()
+
+Human readable description of the assertion.
+
+=item $bool = $assert->{pass}
+
+=item $bool = $assert->pass()
+
+True if the assertion passed.
+
+=item $bool = $assert->{no_debug}
+
+=item $bool = $assert->no_debug()
+
+Set this to true if you have provided custom diagnostics and do not want the
+defaults to be displayed.
+
+=item $int = $assert->{number}
+
+=item $int = $assert->number()
+
+(Optional) assertion number. This may be omitted or ignored. This is usually
+only useful when parsing/processing TAP.
+
+B<Note>: This is not set by the Test2 system, assertion number is not known
+until AFTER the assertion has been processed. This attribute is part of the
+spec only for harnesses.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm
new file mode 100644 (file)
index 0000000..79f2f89
--- /dev/null
@@ -0,0 +1,100 @@
+package Test2::EventFacet::Control;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{ -global -terminate -halt -has_callback -encoding };
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Control - Facet for hub actions and behaviors.
+
+=head1 DESCRIPTION
+
+This facet is used when the event needs to give instructions to the Test2
+internals.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string = $control->{details}
+
+=item $string = $control->details()
+
+Human readable explanation for the special behavior.
+
+=item $bool = $control->{global}
+
+=item $bool = $control->global()
+
+True if the event is global in nature and should be seen by all hubs.
+
+=item $exit = $control->{terminate}
+
+=item $exit = $control->terminate()
+
+Defined if the test should immediately exit, the value is the exit code and may
+be C<0>.
+
+=item $bool = $control->{halt}
+
+=item $bool = $control->halt()
+
+True if all testing should be halted immediately.
+
+=item $bool = $control->{has_callback}
+
+=item $bool = $control->has_callback()
+
+True if the C<callback($hub)> method on the event should be called.
+
+=item $encoding = $control->{encoding}
+
+=item $encoding = $control->encoding()
+
+This can be used to change the encoding from this event onward.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm
new file mode 100644 (file)
index 0000000..2f9f9d7
--- /dev/null
@@ -0,0 +1,93 @@
+package Test2::EventFacet::Error;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+sub facet_key { 'errors' }
+sub is_list { 1 }
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{ -tag -fail };
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Error - Facet for errors that need to be shown.
+
+=head1 DESCRIPTION
+
+This facet is used when an event needs to convey errors.
+
+=head1 NOTES
+
+This facet has the hash key C<'errors'>, and is a list of facets instead of a
+single item.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string = $error->{details}
+
+=item $string = $error->details()
+
+Explanation of the error, or the error itself (such as an exception). In perl
+exceptions may be blessed objects, so this field may contain a blessed object.
+
+=item $short_string = $error->{tag}
+
+=item $short_string = $error->tag()
+
+Short tag to categorize the error. This is usually 10 characters or less,
+formatters may truncate longer tags.
+
+=item $bool = $error->{fail}
+
+=item $bool = $error->fail()
+
+Not all errors are fatal, some are displayed having already been handled. Set
+this to true if you want the error to cause the test to fail. Without this the
+error is simply a diagnostics message that has no effect on the overall
+pass/fail result.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm
new file mode 100644 (file)
index 0000000..a7fac91
--- /dev/null
@@ -0,0 +1,102 @@
+package Test2::EventFacet::Info;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+sub is_list { 1 }
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{-tag -debug -important};
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Info - Facet for information a developer might care about.
+
+=head1 DESCRIPTION
+
+This facet represents messages intended for humans that will help them either
+understand a result, or diagnose a failure.
+
+=head1 NOTES
+
+This facet appears in a list instead of being a single item.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string_or_structure = $info->{details}
+
+=item $string_or_structure = $info->details()
+
+Human readable string or data structure, this is the information to display.
+Formatters are free to render the structures however they please. This may
+contain a blessed object.
+
+=item $short_string = $info->{tag}
+
+=item $short_string = $info->tag()
+
+Short tag to categorize the info. This is usually 10 characters or less,
+formatters may truncate longer tags.
+
+=item $bool = $info->{debug}
+
+=item $bool = $info->debug()
+
+Set this to true if the message is critical, or explains a failure. This is
+info that should be displayed by formatters even in less-verbose modes.
+
+When false the information is not considered critical and may not be rendered
+in less-verbose modes.
+
+=item $bool = $info->{important}
+
+=item $bool = $info->important
+
+This should be set for non debug messages that are still important enough to
+show when a formatter is in quiet mode. A formatter should send these to STDOUT
+not STDERR, but should show them even in non-verbose mode.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm
new file mode 100644 (file)
index 0000000..bab0631
--- /dev/null
@@ -0,0 +1,104 @@
+package Test2::EventFacet::Meta;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use vars qw/$AUTOLOAD/;
+
+# replace set_details
+{
+    no warnings 'redefine';
+    sub set_details { $_[0]->{'set_details'} }
+}
+
+sub can {
+    my $self = shift;
+    my ($name) = @_;
+
+    my $existing = $self->SUPER::can($name);
+    return $existing if $existing;
+
+    # Only vivify when called on an instance, do not vivify for a class. There
+    # are a lot of magic class methods used in things like serialization (or
+    # the forks.pm module) which cause problems when vivified.
+    return undef unless ref($self);
+
+    my $sub = sub { $_[0]->{$name} };
+    {
+        no strict 'refs';
+        *$name = $sub;
+    }
+
+    return $sub;
+}
+
+sub AUTOLOAD {
+    my $name = $AUTOLOAD;
+    $name =~ s/^.*:://g;
+    my $sub = $_[0]->can($name);
+    goto &$sub;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Meta - Facet for meta-data
+
+=head1 DESCRIPTION
+
+This facet can contain any random meta-data that has been attached to the
+event.
+
+=head1 METHODS AND FIELDS
+
+Any/all fields and accessors are autovivified into existence. There is no way
+to know what metadata may be added, so any is allowed.
+
+=over 4
+
+=item $anything = $meta->{anything}
+
+=item $anything = $meta->anything()
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm
new file mode 100644 (file)
index 0000000..5718e17
--- /dev/null
@@ -0,0 +1,98 @@
+package Test2::EventFacet::Parent;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+use Carp qw/confess/;
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{ -hid -children -buffered };
+
+sub init {
+    confess "Attribute 'hid' must be set"
+        unless defined $_[0]->{+HID};
+
+    $_[0]->{+CHILDREN} ||= [];
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Parent - Base class for all event facets.
+
+=head1 DESCRIPTION
+
+This facet is used when an event contains other events, such as a subtest.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string = $parent->{details}
+
+=item $string = $parent->details()
+
+Human readable description of the event.
+
+=item $hid = $parent->{hid}
+
+=item $hid = $parent->hid()
+
+Hub ID of the hub that is represented in the parent-child relationship.
+
+=item $arrayref = $parent->{children}
+
+=item $arrayref = $parent->children()
+
+Arrayref containing the facet-data hashes of events nested under this one.
+
+I<To get the actual events you need to get them from the parent event directly>
+
+=item $bool = $parent->{buffered}
+
+=item $bool = $parent->buffered()
+
+True if the subtest is buffered (meaning the formatter has probably not seen
+them yet).
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm
new file mode 100644 (file)
index 0000000..1584efb
--- /dev/null
@@ -0,0 +1,94 @@
+package Test2::EventFacet::Plan;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+use Test2::Util::HashBase qw{ -count -skip -none };
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Plan - Facet for setting the plan
+
+=head1 DESCRIPTION
+
+Events use this facet when they need to set the plan.
+
+=head1 FIELDS
+
+=over 4
+
+=item $string = $plan->{details}
+
+=item $string = $plan->details()
+
+Human readable explanation for the plan being set. This is normally not
+rendered by most formatters except when the C<skip> field is also set.
+
+=item $positive_int = $plan->{count}
+
+=item $positive_int = $plan->count()
+
+Set the number of expected assertions. This should usually be set to C<0> when
+C<skip> or C<none> are also set.
+
+=item $bool = $plan->{skip}
+
+=item $bool = $plan->skip()
+
+When true the entire test should be skipped. This is usually paired with an
+explanation in the C<details> field, and a C<control> facet that has
+C<terminate> set to C<0>.
+
+=item $bool = $plan->{none}
+
+=item $bool = $plan->none()
+
+This is mainly used by legacy L<Test::Builder> tests which set the plan to C<no
+plan>, a construct that predates the much better C<done_testing()>.
+
+If you are using this in non-legacy code you may need to reconsider the course
+of your life, maybe a hermitage would suite you?
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm
new file mode 100644 (file)
index 0000000..6f93317
--- /dev/null
@@ -0,0 +1,249 @@
+package Test2::EventFacet::Trace;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
+
+use Test2::Util qw/get_tid pkg_to_file/;
+use Carp qw/confess/;
+
+use Test2::Util::HashBase qw{^frame ^pid ^tid ^cid -hid -nested details -buffered};
+
+{
+    no warnings 'once';
+    *DETAIL = \&DETAILS;
+    *detail = \&details;
+    *set_detail = \&set_details;
+}
+
+sub init {
+    confess "The 'frame' attribute is required"
+        unless $_[0]->{+FRAME};
+
+    $_[0]->{+DETAILS} = delete $_[0]->{detail} if $_[0]->{detail};
+
+    $_[0]->{+PID} = $$        unless defined $_[0]->{+PID};
+    $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
+}
+
+sub snapshot {
+    my ($orig, @override) = @_;
+    bless {%$orig, @override}, __PACKAGE__;
+}
+
+sub signature {
+    my $self = shift;
+
+    # Signature is only valid if all of these fields are defined, there is no
+    # signature if any is missing. '0' is ok, but '' is not.
+    return join ':' => map { (defined($_) && length($_)) ? $_ : return undef } (
+        $self->{+CID},
+        $self->{+PID},
+        $self->{+TID},
+        $self->{+FRAME}->[1],
+        $self->{+FRAME}->[2],
+    );
+}
+
+sub debug {
+    my $self = shift;
+    return $self->{+DETAILS} if $self->{+DETAILS};
+    my ($pkg, $file, $line) = $self->call;
+    return "at $file line $line";
+}
+
+sub alert {
+    my $self = shift;
+    my ($msg) = @_;
+    warn $msg . ' ' . $self->debug . ".\n";
+}
+
+sub throw {
+    my $self = shift;
+    my ($msg) = @_;
+    die $msg . ' ' . $self->debug . ".\n";
+}
+
+sub call { @{$_[0]->{+FRAME}} }
+
+sub package { $_[0]->{+FRAME}->[0] }
+sub file    { $_[0]->{+FRAME}->[1] }
+sub line    { $_[0]->{+FRAME}->[2] }
+sub subname { $_[0]->{+FRAME}->[3] }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::EventFacet::Trace - Debug information for events
+
+=head1 DESCRIPTION
+
+The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to
+have access to information about where they were created.  This object
+represents that information.
+
+=head1 SYNOPSIS
+
+    use Test2::EventFacet::Trace;
+
+    my $trace = Test2::EventFacet::Trace->new(
+        frame => [$package, $file, $line, $subname],
+    );
+
+=head1 FACET FIELDS
+
+=over 4
+
+=item $string = $trace->{details}
+
+=item $string = $trace->details()
+
+Used as a custom trace message that will be used INSTEAD of
+C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
+
+=item $frame = $trace->{frame}
+
+=item $frame = $trace->frame()
+
+Get the call frame arrayref.
+
+=item $int = $trace->{pid}
+
+=item $int = $trace->pid()
+
+The process ID in which the event was generated.
+
+=item $int = $trace->{tid}
+
+=item $int = $trace->tid()
+
+The thread ID in which the event was generated.
+
+=item $id = $trace->{cid}
+
+=item $id = $trace->cid()
+
+The ID of the context that was used to create the event.
+
+=item $hid = $trace->{hid}
+
+=item $hid = $trace->hid()
+
+The ID of the hub that was current when the event was created.
+
+=item $int = $trace->{nested}
+
+=item $int = $trace->nested()
+
+How deeply nested the event is.
+
+=item $bool = $trace->{buffered}
+
+=item $bool = $trace->buffered()
+
+True if the event was buffered and not sent to the formatter independent of a
+parent (This should never be set when nested is C<0> or C<undef>).
+
+=back
+
+=head1 METHODS
+
+B<Note:> All facet frames are also methods.
+
+=over 4
+
+=item $trace->set_detail($msg)
+
+=item $msg = $trace->detail
+
+Used to get/set a custom trace message that will be used INSTEAD of
+C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
+
+C<detail()> is an alias to the C<details> facet field for backwards
+compatibility.
+
+=item $str = $trace->debug
+
+Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set
+then its value will be returned instead.
+
+=item $trace->alert($MESSAGE)
+
+This issues a warning at the frame (filename and line number where
+errors should be reported).
+
+=item $trace->throw($MESSAGE)
+
+This throws an exception at the frame (filename and line number where
+errors should be reported).
+
+=item ($package, $file, $line, $subname) = $trace->call()
+
+Get the caller details for the debug-info. This is where errors should be
+reported.
+
+=item $pkg = $trace->package
+
+Get the debug-info package.
+
+=item $file = $trace->file
+
+Get the debug-info filename.
+
+=item $line = $trace->line
+
+Get the debug-info line number.
+
+=item $subname = $trace->subname
+
+Get the debug-info subroutine name.
+
+=item $sig = trace->signature
+
+Get a signature string that identifies this trace. This is used to check if
+multiple events are related. The Trace includes pid, tid, file, line number,
+and the cid which is C<'C\d+'> for traces created by a context, or C<'T\d+'>
+for traces created by C<new()>.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
index 945d545..cd1a784 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 my %ADDED;
@@ -14,6 +14,11 @@ sub import {
     Test2::API::test2_formatter_add($class);
 }
 
+sub new_root {
+    my $class = shift;
+    return $class->new(@_);
+}
+
 sub hide_buffered { 1 }
 
 sub terminate { }
@@ -56,6 +61,12 @@ A formatter is any package or object with a C<write($event, $num)> method.
 
     sub finalize { }
 
+    sub new_root {
+        my $class = shift;
+        ...
+        $class->new(@_);
+    }
+
     1;
 
 The C<write> method is a method, so it either gets a class or instance. The two
@@ -81,6 +92,12 @@ The C<finalize> method is always the last thing called on the formatter, I<<
 except when C<terminate> is called for a Bail event >>. It is passed the
 following arguments:
 
+The C<new_root> method is called when C<Test2::API::Stack> Initializes the root
+hub for the first time. Most formatters will simply have this call C<<
+$class->new >>, which is the default behavior. Some formatters however may want
+to take extra action during construction of the root formatter, this is where
+they can do that.
+
 =over 4
 
 =item * The number of tests that were planned
@@ -118,7 +135,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 680095c..d2dbc64 100644 (file)
@@ -1,49 +1,33 @@
 package Test2::Formatter::TAP;
 use strict;
 use warnings;
-require PerlIO;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
+
+use Test2::Util qw/clone_io/;
 
 use Test2::Util::HashBase qw{
-    no_numbers handles _encoding
+    no_numbers handles _encoding _last_fh
+    -made_assertion
 };
 
 sub OUT_STD() { 0 }
 sub OUT_ERR() { 1 }
 
-use Carp qw/croak/;
-
 BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) }
 
-my %CONVERTERS = (
-    'Test2::Event::Ok'           => 'event_ok',
-    'Test2::Event::Skip'         => 'event_skip',
-    'Test2::Event::Note'         => 'event_note',
-    'Test2::Event::Diag'         => 'event_diag',
-    'Test2::Event::Bail'         => 'event_bail',
-    'Test2::Event::Exception'    => 'event_exception',
-    'Test2::Event::Subtest'      => 'event_subtest',
-    'Test2::Event::Plan'         => 'event_plan',
-    'Test2::Event::TAP::Version' => 'event_version',
-);
-
-# Initial list of converters are safe for direct hash access cause we control them.
-my %SAFE_TO_ACCESS_HASH = %CONVERTERS;
-
-sub register_event {
-    my $class = shift;
-    my ($type, $convert) = @_;
-    croak "Event type is a required argument" unless $type;
-    croak "Event type '$type' already registered" if $CONVERTERS{$type};
-    croak "The second argument to register_event() must be a code reference or method name"
-        unless $convert && (ref($convert) eq 'CODE' || $class->can($convert));
-    $CONVERTERS{$type} = $convert;
+sub _autoflush {
+    my($fh) = pop;
+    my $old_fh = select $fh;
+    $| = 1;
+    select $old_fh;
 }
 
 _autoflush(\*STDOUT);
 _autoflush(\*STDERR);
 
+sub hide_buffered { 1 }
+
 sub init {
     my $self = shift;
 
@@ -53,7 +37,18 @@ sub init {
     }
 }
 
-sub hide_buffered { 1 }
+sub _open_handles {
+    my $self = shift;
+
+    require Test2::API;
+    my $out = clone_io(Test2::API::test2_stdout());
+    my $err = clone_io(Test2::API::test2_stderr());
+
+    _autoflush($out);
+    _autoflush($err);
+
+    return [$out, $err];
+}
 
 sub encoding {
     my $self = shift;
@@ -82,15 +77,21 @@ if ($^C) {
     *write = sub {};
 }
 sub write {
-    my ($self, $e, $num) = @_;
+    my ($self, $e, $num, $f) = @_;
 
-    my $type = ref($e);
+    # The most common case, a pass event with no amnesty and a normal name.
+    return if $self->print_optimal_pass($e, $num);
+
+    $f ||= $e->facet_data;
+
+    $self->encoding($f->{control}->{encoding}) if $f->{control}->{encoding};
+
+    my @tap = $self->event_tap($f, $num) or return;
 
-    my $converter = $CONVERTERS{$type} || 'event_other';
-    my @tap = $self->$converter($e, $self->{+NO_NUMBERS} ? undef : $num) or return;
+    $self->{+MADE_ASSERTION} = 1 if $f->{assert};
 
+    my $nesting = $f->{trace}->{nested} || 0;
     my $handles = $self->{+HANDLES};
-    my $nesting = ($SAFE_TO_ACCESS_HASH{$type} ? $e->{nested} : $e->nested) || 0;
     my $indent = '    ' x $nesting;
 
     # Local is expensive! Only do it if we really need to.
@@ -101,59 +102,137 @@ sub write {
         next unless $msg;
         my $io = $handles->[$hid] or next;
 
+        print $io "\n"
+            if $ENV{HARNESS_ACTIVE}
+            && !$ENV{HARNESS_IS_VERBOSE}
+            && $hid == OUT_ERR
+            && $self->{+_LAST_FH} != $io
+            && $msg =~ m/^#\s*Failed test /;
+
         $msg =~ s/^/$indent/mg if $nesting;
         print $io $msg;
+        $self->{+_LAST_FH} = $io;
     }
 }
 
-sub _open_handles {
-    my $self = shift;
+sub print_optimal_pass {
+    my ($self, $e, $num) = @_;
 
-    my %seen;
-    open(my $out, '>&', STDOUT) or die "Can't dup STDOUT:  $!";
-    binmode($out, join(":", "", "raw", grep { $_ ne 'unix' and !$seen{$_}++ } PerlIO::get_layers(STDOUT)));
+    my $type = ref($e);
 
-    %seen = ();
-    open(my $err, '>&', STDERR) or die "Can't dup STDERR:  $!";
-    binmode($err, join(":", "", "raw", grep { $_ ne 'unix' and !$seen{$_}++ } PerlIO::get_layers(STDERR)));
+    # Only optimal if this is a Pass or a passing Ok
+    return unless $type eq 'Test2::Event::Pass' || ($type eq 'Test2::Event::Ok' && $e->{pass});
 
-    _autoflush($out);
-    _autoflush($err);
+    # Amnesty requires further processing (todo is a form of amnesty)
+    return if ($e->{amnesty} && @{$e->{amnesty}}) || defined($e->{todo});
 
-    return [$out, $err];
-}
+    # A name with a newline or hash symbol needs extra processing
+    return if defined($e->{name}) && (-1 != index($e->{name}, "\n") || -1 != index($e->{name}, '#'));
 
-sub _autoflush {
-    my($fh) = pop;
-    my $old_fh = select $fh;
-    $| = 1;
-    select $old_fh;
+    my $ok = 'ok';
+    $ok .= " $num" if $num && !$self->{+NO_NUMBERS};
+    $ok .= defined($e->{name}) ? " - $e->{name}\n" : "\n";
+
+    if (my $nesting = $e->{trace}->{nested}) {
+        my $indent = '    ' x $nesting;
+        $ok = "$indent$ok";
+    }
+
+    my $io = $self->{+HANDLES}->[OUT_STD];
+
+    local($\, $,) = (undef, '') if $\ || $,;
+    print $io $ok;
+    $self->{+_LAST_FH} = $io;
+
+    return 1;
 }
 
 sub event_tap {
+    my ($self, $f, $num) = @_;
+
+    my @tap;
+
+    # If this IS the first event the plan should come first
+    # (plan must be before or after assertions, not in the middle)
+    push @tap => $self->plan_tap($f) if $f->{plan} && !$self->{+MADE_ASSERTION};
+
+    # The assertion is most important, if present.
+    if ($f->{assert}) {
+        push @tap => $self->assert_tap($f, $num);
+        push @tap => $self->debug_tap($f, $num) unless $f->{assert}->{no_debug} || $f->{assert}->{pass};
+    }
+
+    # Almost as important as an assertion
+    push @tap => $self->error_tap($f) if $f->{errors};
+
+    # Now lets see the diagnostics messages
+    push @tap => $self->info_tap($f) if $f->{info};
+
+    # If this IS NOT the first event the plan should come last
+    # (plan must be before or after assertions, not in the middle)
+    push @tap => $self->plan_tap($f) if $self->{+MADE_ASSERTION} && $f->{plan};
+
+    # Bail out
+    push @tap => $self->halt_tap($f) if $f->{control}->{halt};
+
+    return @tap if @tap;
+    return @tap if $f->{control}->{halt};
+    return @tap if grep { $f->{$_} } qw/assert plan info errors/;
+
+    # Use the summary as a fallback if nothing else is usable.
+    return $self->summary_tap($f, $num);
+}
+
+sub error_tap {
     my $self = shift;
-    my ($e, $num) = @_;
+    my ($f) = @_;
 
-    my $converter = $CONVERTERS{ref($e)} or return;
+    return map {
+        my $details = $_->{details};
 
-    $num = undef if $self->{+NO_NUMBERS};
+        my $msg;
+        if (ref($details)) {
+            require Data::Dumper;
+            my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Pad('# ')->Useqq(1)->Sortkeys(1);
+            chomp($msg = $dumper->Dump);
+        }
+        else {
+            chomp($msg = $details);
+            $msg =~ s/^/# /;
+            $msg =~ s/\n/\n# /g;
+        }
+
+        [OUT_ERR, "$msg\n"];
+    } @{$f->{errors}};
+}
+
+sub plan_tap {
+    my $self = shift;
+    my ($f) = @_;
+    my $plan = $f->{plan} or return;
+
+    return if $plan->{none};
+
+    if ($plan->{skip}) {
+        my $reason = $plan->{details} or return [OUT_STD, "1..0 # SKIP\n"];
+        chomp($reason);
+        return [OUT_STD, '1..0 # SKIP ' . $reason . "\n"];
+    }
 
-    return $self->$converter($e, $num);
+    return [OUT_STD, "1.." . $plan->{count} . "\n"];
 }
 
-sub event_ok {
+sub no_subtest_space { 0 }
+sub assert_tap {
     my $self = shift;
-    my ($e, $num) = @_;
+    my ($f, $num) = @_;
 
-    # We use direct hash access for performance. OK events are so common we
-    # need this to be fast.
-    my ($name, $todo) = @{$e}{qw/name todo/};
-    my $in_todo = defined($todo);
+    my $assert = $f->{assert} or return;
+    my $pass = $assert->{pass};
+    my $name = $assert->{details};
 
-    my $out = "";
-    $out .= "not " unless $e->{pass};
-    $out .= "ok";
-    $out .= " $num" if defined($num);
+    my $ok = $pass ? 'ok' : 'not ok';
+    $ok .= " $num" if $num && !$self->{+NO_NUMBERS};
 
     # The regex form is ~250ms, the index form is ~50ms
     my @extra;
@@ -162,194 +241,155 @@ sub event_ok {
         ((index($name, "#" ) != -1  || substr($name, -1) eq '\\') && (($name =~ s|\\|\\\\|g), ($name =~ s|#|\\#|g)))
     );
 
-    my $space = @extra ? ' ' x (length($out) + 2) : '';
+    my $extra_space = @extra ? ' ' x (length($ok) + 2) : '';
+    my $extra_indent = '';
 
-    $out .= " - $name" if defined $name;
-    $out .= " # TODO" if $in_todo;
-    $out .= " $todo" if defined($todo) && length($todo);
+    my ($directives, $reason, $is_skip);
+    if ($f->{amnesty}) {
+        my %directives;
 
-    # The primary line of TAP, if the test passed this is all we need.
-    return([OUT_STD, "$out\n"]) unless @extra;
+        for my $am (@{$f->{amnesty}}) {
+            next if $am->{inherited};
+            my $tag = $am->{tag} or next;
+            $is_skip = 1 if $tag eq 'skip';
 
-    return $self->event_ok_multiline($out, $space, @extra);
-}
+            $directives{$tag} ||= $am->{details};
+        }
 
-sub event_ok_multiline {
-    my $self = shift;
-    my ($out, $space, @extra) = @_;
+        my %seen;
+        my @order = grep { !$seen{$_}++ } sort keys %directives;
 
-    return(
-        [OUT_STD, "$out\n"],
-        map {[OUT_STD, "#${space}$_\n"]} @extra,
-    );
-}
+        $directives = ' # ' . join ' & ' => @order;
 
-sub event_skip {
-    my $self = shift;
-    my ($e, $num) = @_;
-
-    my $name   = $e->name;
-    my $reason = $e->reason;
-    my $todo   = $e->todo;
-
-    my $out = "";
-    $out .= "not " unless $e->{pass};
-    $out .= "ok";
-    $out .= " $num" if defined $num;
-    $out .= " - $name" if $name;
-    if (defined($todo)) {
-        $out .= " # TODO & SKIP"
-    }
-    else {
-        $out .= " # skip";
+        for my $tag ('skip', @order) {
+            next unless defined($directives{$tag}) && length($directives{$tag});
+            $reason = $directives{$tag};
+            last;
+        }
     }
-    $out .= " $reason" if defined($reason) && length($reason);
 
-    return([OUT_STD, "$out\n"]);
-}
+    $ok .= " - $name" if defined $name && !($is_skip && !$name);
 
-sub event_note {
-    my $self = shift;
-    my ($e, $num) = @_;
+    my @subtap;
+    if ($f->{parent} && $f->{parent}->{buffered}) {
+        $ok .= ' {';
 
-    chomp(my $msg = $e->message);
-    $msg =~ s/^/# /;
-    $msg =~ s/\n/\n# /g;
+        # In a verbose harness we indent the extra since they will appear
+        # inside the subtest braces. This helps readability. In a non-verbose
+        # harness we do not do this because it is less readable.
+        if ($ENV{HARNESS_IS_VERBOSE} || !$ENV{HARNESS_ACTIVE}) {
+            $extra_indent = "    ";
+            $extra_space = ' ';
+        }
 
-    return [OUT_STD, "$msg\n"];
-}
+        # Render the sub-events, we use our own counter for these.
+        my $count = 0;
+        @subtap = map {
+            my $f2 = $_;
 
-sub event_diag {
-    my $self = shift;
-    my ($e, $num) = @_;
+            # Bump the count for any event that should bump it.
+            $count++ if $f2->{assert};
 
-    chomp(my $msg = $e->message);
-    $msg =~ s/^/# /;
-    $msg =~ s/\n/\n# /g;
+            # This indents all output lines generated for the sub-events.
+            # index 0 is the filehandle, index 1 is the message we want to indent.
+            map { $_->[1] =~ s/^(.*\S.*)$/    $1/mg; $_ } $self->event_tap($f2, $count);
+        } @{$f->{parent}->{children}};
 
-    return [OUT_ERR, "$msg\n"];
-}
+        push @subtap => [OUT_STD, "}\n"];
+    }
 
-sub event_bail {
-    my $self = shift;
-    my ($e, $num) = @_;
+    if ($directives) {
+        $directives = ' # TODO & SKIP' if $directives eq ' # TODO & skip';
+        $ok .= $directives;
+        $ok .= " $reason" if defined($reason);
+    }
 
-    return if $e->nested;
+    $extra_space = ' ' if $self->no_subtest_space;
 
-    return [
-        OUT_STD,
-        "Bail out!  " . $e->reason . "\n",
-    ];
-}
+    my @out = ([OUT_STD, "$ok\n"]);
+    push @out => map {[OUT_STD, "${extra_indent}#${extra_space}$_\n"]} @extra if @extra;
+    push @out => @subtap;
 
-sub event_exception {
-    my $self = shift;
-    my ($e, $num) = @_;
-    return [ OUT_ERR, $e->error ];
+    return @out;
 }
 
-sub event_subtest {
-    my $self = shift;
-    my ($e, $num) = @_;
-
-    # A 'subtest' is a subclass of 'ok'. Let the code that renders 'ok' render
-    # this event.
-    my ($ok, @diag) = $self->event_ok($e, $num);
-
-    # If the subtest is not buffered then the sub-events have already been
-    # rendered, we can go ahead and return.
-    return ($ok, @diag) unless $e->buffered;
-
-    # 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 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;
-    }
+sub debug_tap {
+    my ($self, $f, $num) = @_;
 
-    # Add the trailing ' {' to the 'ok' line of TAP output.
-    $ok->[1] =~ s/\n/ {\n/;
-
-    # Render the sub-events, we use our own counter for these.
-    my $count = 0;
-    my @subs = map {
-        # Bump the count for any event that should bump it.
-        $count++ if $_->increments_count;
-
-        # This indents all output lines generated for the sub-events.
-        # index 0 is the filehandle, index 1 is the message we want to indent.
-        map { $_->[1] =~ s/^(.*\S.*)$/    $1/mg; $_ } $self->event_tap($_, $count);
-    } @{$e->subevents};
-
-    return (
-        $ok,                # opening ok - name {
-        @diag,              #   diagnostics if the subtest failed
-        @subs,              #   All the inner-event lines
-        [OUT_STD(), "}\n"], # } (closing brace)
-    );
-}
+    # Figure out the debug info, this is typically the file name and line
+    # number, but can also be a custom message. If no trace object is provided
+    # then we have nothing useful to display.
+    my $name  = $f->{assert}->{details};
+    my $trace = $f->{trace};
 
-sub event_plan {
-    my $self = shift;
-    my ($e, $num) = @_;
+    my $debug = "[No trace info available]";
+    if ($trace->{details}) {
+        $debug = $trace->{details};
+    }
+    elsif ($trace->{frame}) {
+        my ($pkg, $file, $line) = @{$trace->{frame}};
+        $debug = "at $file line $line." if $file && $line;
+    }
 
-    my $directive = $e->directive;
-    return if $directive && $directive eq 'NO PLAN';
+    my $amnesty = $f->{amnesty} && @{$f->{amnesty}}
+        ? ' (with amnesty)'
+        : '';
 
-    my $reason = $e->reason;
-    $reason =~ s/\n/\n# /g if $reason;
+    # Create the initial diagnostics. If the test has a name we put the debug
+    # info on a second line, this behavior is inherited from Test::Builder.
+    my $msg = defined($name)
+        ? qq[# Failed test${amnesty} '$name'\n# $debug\n]
+        : qq[# Failed test${amnesty} $debug\n];
 
-    my $plan = "1.." . $e->max;
-    if ($directive) {
-        $plan .= " # $directive";
-        $plan .= " $reason" if defined $reason;
-    }
+    my $IO = $f->{amnesty} && @{$f->{amnesty}} ? OUT_STD : OUT_ERR;
 
-    return [OUT_STD, "$plan\n"];
+    return [$IO, $msg];
 }
 
-sub event_version {
-    my $self = shift;
-    my ($e, $num) = @_;
+sub halt_tap {
+    my ($self, $f) = @_;
 
-    my $version = $e->version;
+    return if $f->{trace}->{nested} && !$f->{trace}->{buffered};
+    my $details = $f->{control}->{details};
 
-    return [OUT_STD, "TAP version $version\n"];
+    return [OUT_STD, "Bail out!\n"] unless defined($details) && length($details);
+    return [OUT_STD, "Bail out!  $details\n"];
 }
 
-sub event_other {
-    my $self = shift;
-    my ($e, $num) = @_;
-    return if $e->no_display;
+sub info_tap {
+    my ($self, $f) = @_;
 
-    my @out;
+    return map {
+        my $details = $_->{details};
 
-    if (my ($max, $directive, $reason) = $e->sets_plan) {
-        my $plan = "1..$max";
-        $plan .= " # $directive" if $directive;
-        $plan .= " $reason" if defined $reason;
-        push @out => [OUT_STD, "$plan\n"];
-    }
+        my $IO = $_->{debug} ? OUT_ERR : OUT_STD;
 
-    if ($e->increments_count) {
-        my $ok = "";
-        $ok .= "not " if $e->causes_fail;
-        $ok .= "ok";
-        $ok .= " $num" if defined($num);
-        $ok .= " - " . $e->summary if $e->summary;
+        my $msg;
+        if (ref($details)) {
+            require Data::Dumper;
+            my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Pad('# ')->Useqq(1)->Sortkeys(1);
+            chomp($msg = $dumper->Dump);
+        }
+        else {
+            chomp($msg = $details);
+            $msg =~ s/^/# /;
+            $msg =~ s/\n/\n# /g;
+        }
 
-        push @out => [OUT_STD, "$ok\n"];
-    }
-    else { # Comment
-        my $handle =  ($e->causes_fail || $e->diagnostics) ? OUT_ERR : OUT_STD;
-        my $summary = $e->summary || ref($e);
-        chomp($summary);
-        $summary =~ s/^/# /smg;
-        push @out => [$handle, "$summary\n"];
-    }
+        [$IO, "$msg\n"];
+    } @{$f->{info}};
+}
 
-    return @out;
+sub summary_tap {
+    my ($self, $f, $num) = @_;
+
+    return if $f->{about}->{no_display};
+
+    my $summary = $f->{about}->{details} or return;
+    chomp($summary);
+    $summary =~ s/^/# /smg;
+
+    return [OUT_STD, "$summary\n"];
 }
 
 1;
@@ -408,99 +448,6 @@ This directly modifies the stored filehandles, it does not create new ones.
 
 Write an event to the console.
 
-=item Test2::Formatter::TAP->register_event($pkg, sub { ... });
-
-In general custom events are not supported. There are however occasions where
-you might want to write a custom event type that results in TAP output. In
-order to do this you use the C<register_event()> class method.
-
-    package My::Event;
-    use Test2::Formatter::TAP;
-
-    use base 'Test2::Event';
-    use Test2::Util::HashBase qw/pass name diag note/;
-
-    Test2::Formatter::TAP->register_event(
-        __PACKAGE__,
-        sub {
-            my $self = shift;
-            my ($e, $num) = @_;
-            return (
-                [Test2::Formatter::TAP::OUT_STD, "ok $num - " . $e->name . "\n"],
-                [Test2::Formatter::TAP::OUT_ERR, "# " . $e->name . " " . $e->diag . "\n"],
-                [Test2::Formatter::TAP::OUT_STD, "# " . $e->name . " " . $e->note . "\n"],
-            );
-        }
-    );
-
-    1;
-
-=back
-
-=head2 EVENT METHODS
-
-All these methods require the event itself. Optionally they can all except a
-test number.
-
-All methods return a list of array-refs. Each array-ref will have 2 items, the
-first is an integer identifying an output handle, the second is a string that
-should be written to the handle.
-
-=over 4
-
-=item @out = $TAP->event_ok($e)
-
-=item @out = $TAP->event_ok($e, $num)
-
-Process an L<Test2::Event::Ok> event.
-
-=item @out = $TAP->event_plan($e)
-
-=item @out = $TAP->event_plan($e, $num)
-
-Process an L<Test2::Event::Plan> event.
-
-=item @out = $TAP->event_note($e)
-
-=item @out = $TAP->event_note($e, $num)
-
-Process an L<Test2::Event::Note> event.
-
-=item @out = $TAP->event_diag($e)
-
-=item @out = $TAP->event_diag($e, $num)
-
-Process an L<Test2::Event::Diag> event.
-
-=item @out = $TAP->event_bail($e)
-
-=item @out = $TAP->event_bail($e, $num)
-
-Process an L<Test2::Event::Bail> event.
-
-=item @out = $TAP->event_exception($e)
-
-=item @out = $TAP->event_exception($e, $num)
-
-Process an L<Test2::Event::Exception> event.
-
-=item @out = $TAP->event_skip($e)
-
-=item @out = $TAP->event_skip($e, $num)
-
-Process an L<Test2::Event::Skip> event.
-
-=item @out = $TAP->event_subtest($e)
-
-=item @out = $TAP->event_subtest($e, $num)
-
-Process an L<Test2::Event::Subtest> event.
-
-=item @out = $TAP->event_other($e, $num)
-
-Fallback for unregistered event types. It uses the L<Test2::Event> API to
-convert the event to TAP.
-
 =back
 
 =head1 SOURCE
@@ -528,7 +475,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 324f1a8..9169f0b 100644 (file)
@@ -2,17 +2,19 @@ package Test2::Hub;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Carp qw/carp croak confess/;
 use Test2::Util qw/get_tid ipc_separator/;
 
 use Scalar::Util qw/weaken/;
+use List::Util qw/first/;
 
 use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
 use Test2::Util::HashBase qw{
     pid tid hid ipc
+    nested buffered
     no_ending
     _filters
     _pre_filters
@@ -41,6 +43,9 @@ sub init {
     $self->{+TID} = get_tid();
     $self->{+HID} = join ipc_separator, $self->{+PID}, $self->{+TID}, $ID_POSTFIX++;
 
+    $self->{+NESTED}   = 0 unless defined $self->{+NESTED};
+    $self->{+BUFFERED} = 0 unless defined $self->{+BUFFERED};
+
     $self->{+COUNT}    = 0;
     $self->{+FAILED}   = 0;
     $self->{+_PASSING} = 1;
@@ -56,6 +61,21 @@ sub init {
 
 sub is_subtest { 0 }
 
+sub _tb_reset {
+    my $self = shift;
+
+    # Nothing to do
+    return if $self->{+PID} == $$ && $self->{+TID} == get_tid();
+
+    $self->{+PID} = $$;
+    $self->{+TID} = get_tid();
+    $self->{+HID} = join ipc_separator, $self->{+PID}, $self->{+TID}, $ID_POSTFIX++;
+
+    if (my $ipc = $self->{+IPC}) {
+        $ipc->add_hub($self->{+HID});
+    }
+}
+
 sub reset_state {
     my $self = shift;
 
@@ -73,6 +93,8 @@ sub inherit {
     my $self = shift;
     my ($from, %params) = @_;
 
+    $self->{+NESTED} ||= 0;
+
     $self->{+_FORMATTER} = $from->{+_FORMATTER}
         unless $self->{+_FORMATTER} || exists($params{formatter});
 
@@ -281,32 +303,63 @@ sub process {
         }
     }
 
+    # Optimize the most common case
     my $type = ref($e);
-    my $is_ok = $type eq 'Test2::Event::Ok';
-    my $no_fail = $type eq 'Test2::Event::Diag' || $type eq 'Test2::Event::Note';
-    my $causes_fail = $is_ok ? !$e->{effective_pass} : $no_fail ? 0 : $e->causes_fail;
-    my $counted = $is_ok || (!$no_fail && $e->increments_count);
+    if ($type eq 'Test2::Event::Pass' || ($type eq 'Test2::Event::Ok' && $e->{pass})) {
+        my $count = ++($self->{+COUNT});
+        $self->{+_FORMATTER}->write($e, $count) if $self->{+_FORMATTER};
 
-    $self->{+COUNT}++      if $counted;
-    $self->{+FAILED}++     if $causes_fail && $counted;
-    $self->{+_PASSING} = 0 if $causes_fail;
+        if ($self->{+_LISTENERS}) {
+            $_->{code}->($self, $e, $count) for @{$self->{+_LISTENERS}};
+        }
+
+        return $e;
+    }
+
+    my $f = $e->facet_data;
 
-    my $callback = $e->callback($self) unless $is_ok || $no_fail;
+    my $fail = 0;
+    $fail = 1 if $f->{assert} && !$f->{assert}->{pass};
+    $fail = 1 if $f->{error}  && $f->{error}->{fail};
+    $fail = 0 if $f->{amnesty};
 
+    $self->{+COUNT}++ if $f->{assert};
+    $self->{+FAILED}++ if $fail && $f->{assert};
+    $self->{+_PASSING} = 0 if $fail;
+
+    my $code = $f->{control}->{terminate};
     my $count = $self->{+COUNT};
 
-    $self->{+_FORMATTER}->write($e, $count) if $self->{+_FORMATTER};
+    if (my $plan = $f->{plan}) {
+        if ($plan->{skip}) {
+            $self->plan('SKIP');
+            $self->set_skip_reason($plan->{details} || 1);
+            $code ||= 0;
+        }
+        elsif ($plan->{none}) {
+            $self->plan('NO PLAN');
+        }
+        else {
+            $self->plan($plan->{count});
+        }
+    }
+
+    $e->callback($self) if $f->{control}->{has_callback};
+
+    $self->{+_FORMATTER}->write($e, $count, $f) if $self->{+_FORMATTER};
 
     if ($self->{+_LISTENERS}) {
-        $_->{code}->($self, $e, $count) for @{$self->{+_LISTENERS}};
+        $_->{code}->($self, $e, $count, $f) for @{$self->{+_LISTENERS}};
     }
 
-    return $e if $is_ok || $no_fail;
+    if ($f->{control}->{halt}) {
+        $code ||= 255;
+        $self->set_bailed_out($e);
+    }
 
-    my $code = $e->terminate;
     if (defined $code) {
-        $self->{+_FORMATTER}->terminate($e) if $self->{+_FORMATTER};
-        $self->terminate($code, $e);
+        $self->{+_FORMATTER}->terminate($e, $f) if $self->{+_FORMATTER};
+        $self->terminate($code, $e, $f);
     }
 
     return $e;
@@ -339,11 +392,11 @@ sub finalize {
     my $failed = $self->{+FAILED};
     my $active = $self->{+ACTIVE};
 
-       # return if NOTHING was done.
-       unless ($active || $do_plan || defined($plan) || $count || $failed) {
-               $self->{+_FORMATTER}->finalize($plan, $count, $failed, 0, $self->is_subtest) if $self->{+_FORMATTER};
-               return;
-       }
+    # return if NOTHING was done.
+    unless ($active || $do_plan || defined($plan) || $count || $failed) {
+        $self->{+_FORMATTER}->finalize($plan, $count, $failed, 0, $self->is_subtest) if $self->{+_FORMATTER};
+        return;
+    }
 
     unless ($self->{+ENDED}) {
         if ($self->{+_FOLLOW_UPS}) {
@@ -381,7 +434,7 @@ Second End: $sfile line $sline
     $self->{+ENDED} = $frame;
     my $pass = $self->is_passing(); # Generate the final boolean.
 
-       $self->{+_FORMATTER}->finalize($plan, $count, $failed, $pass, $self->is_subtest) if $self->{+_FORMATTER};
+    $self->{+_FORMATTER}->finalize($plan, $count, $failed, $pass, $self->is_subtest) if $self->{+_FORMATTER};
 
     return $pass;
 }
@@ -452,7 +505,6 @@ sub DESTROY {
     my $ipc = $self->{+IPC} || return;
     return unless $$ == $self->{+PID};
     return unless get_tid() == $self->{+TID};
-
     $ipc->drop_hub($self->{+HID});
 }
 
@@ -640,7 +692,7 @@ the reference returned by C<filter()> or C<pre_filter()>.
 =item $hub->follow_op(sub { ... })
 
 Use this to add behaviors that are called just before the hub is finalized. The
-only argument to your codeblock will be a L<Test2::Util::Trace> instance.
+only argument to your codeblock will be a L<Test2::EventFacet::Trace> instance.
 
     $hub->follow_up(sub {
         my ($trace, $hub) = @_;
@@ -819,7 +871,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 42be265..efeb09f 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Test2::Hub::Interceptor::Terminator();
@@ -10,10 +10,18 @@ use Test2::Hub::Interceptor::Terminator();
 BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
 use Test2::Util::HashBase;
 
+sub init {
+    my $self = shift;
+    $self->SUPER::init;
+    $self->{+NESTED} = 0;
+}
+
 sub inherit {
     my $self = shift;
     my ($from, %params) = @_;
 
+    $self->{+NESTED} = 0;
+
     if ($from->{+IPC} && !$self->{+IPC} && !exists($params{ipc})) {
         my $ipc = $from->{+IPC};
         $self->{+IPC} = $ipc;
@@ -70,7 +78,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index f720190..51d5040 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 1;
@@ -41,7 +41,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index adb3d6f..aa0a939 100644 (file)
@@ -2,29 +2,29 @@ package Test2::Hub::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
-
+our $VERSION = '1.302096';
 
 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::HashBase qw/nested exit_code manual_skip_all/;
 use Test2::Util qw/get_tid/;
 
-my $ID = 1;
-sub init {
-    my $self = shift;
-    $self->SUPER::init(@_);
-    $self->{+ID} ||= join "-", $$, get_tid, $ID++;
-}
-
 sub is_subtest { 1 }
 
-sub process {
+sub inherit {
     my $self = shift;
-    my ($e) = @_;
-    $e->set_nested($self->nested);
-    $e->set_in_subtest($self->{+ID});
-    $self->set_bailed_out($e) if $e->isa('Test2::Event::Bail');
-    $self->SUPER::process($e);
+    my ($from) = @_;
+
+    $self->SUPER::inherit($from);
+
+    $self->{+NESTED} = $from->nested + 1;
+}
+
+{
+    # Legacy
+    no warnings 'once';
+    *ID = \&Test2::Hub::HID;
+    *id = \&Test2::Hub::hid;
+    *set_id = \&Test2::Hub::set_hid;
 }
 
 sub send {
@@ -34,9 +34,15 @@ sub send {
     my $out = $self->SUPER::send($e);
 
     return $out if $self->{+MANUAL_SKIP_ALL};
-    return $out unless $e->isa('Test2::Event::Plan')
-        && $e->directive eq 'SKIP'
-        && ($e->trace->pid != $self->pid || $e->trace->tid != $self->tid);
+
+    my $f = $e->facet_data;
+
+    my $plan = $f->{plan} or return $out;
+    return $out unless $plan->{skip};
+
+    my $trace = $f->{trace} or die "Missing Trace!";
+    return $out unless $trace->{pid} != $self->pid
+                    || $trace->{tid} != $self->tid;
 
     no warnings 'exiting';
     last T2_SUBTEST_WRAPPER;
@@ -44,13 +50,18 @@ sub send {
 
 sub terminate {
     my $self = shift;
-    my ($code, $e) = @_;
+    my ($code, $e, $f) = @_;
     $self->set_exit_code($code);
 
     return if $self->{+MANUAL_SKIP_ALL};
-    return if $e->isa('Test2::Event::Plan')
-           && $e->directive eq 'SKIP'
-           && ($e->trace->pid != $$ || $e->trace->tid != get_tid);
+
+    $f ||= $e->facet_data;
+
+    if(my $plan = $f->{plan}) {
+        my $trace = $f->{trace} or die "Missing Trace!";
+        return if $plan->{skip}
+               && ($trace->{pid} != $$ || $trace->{tid} != get_tid);
+    }
 
     no warnings 'exiting';
     last T2_SUBTEST_WRAPPER;
@@ -115,7 +126,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 9244791..c6f872e 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Test2::API::Instance;
@@ -130,7 +130,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index cd34f7c..7f3e10b 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC::Driver;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Carp qw/confess longmess/;
@@ -282,7 +282,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 998fef5..c847966 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC::Driver::Files;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
@@ -15,54 +15,9 @@ use Storable();
 use File::Spec();
 use POSIX();
 
-use Test2::Util qw/try get_tid pkg_to_file IS_WIN32 ipc_separator/;
+use Test2::Util qw/try get_tid pkg_to_file IS_WIN32 ipc_separator do_rename do_unlink try_sig_mask/;
 use Test2::API qw/test2_ipc_set_pending/;
 
-BEGIN {
-    if (IS_WIN32) {
-        my $max_tries = 5;
-
-        *do_rename = sub {
-            my ($from, $to) = @_;
-
-            my $err;
-            for (1 .. $max_tries) {
-                return (1) if rename($from, $to);
-                $err = "$!";
-                last if $_ == $max_tries;
-                sleep 1;
-            }
-
-            return (0, $err);
-        };
-        *do_unlink = sub {
-            my ($file) = @_;
-
-            my $err;
-            for (1 .. $max_tries) {
-                return (1) if unlink($file);
-                $err = "$!";
-                last if $_ == $max_tries;
-                sleep 1;
-            }
-
-            return (0, "$!");
-        };
-    }
-    else {
-        *do_rename = sub {
-            my ($from, $to) = @_;
-            return (1) if rename($from, $to);
-            return (0, "$!");
-        };
-        *do_unlink = sub {
-            my ($file) = @_;
-            return (1) if unlink($file);
-            return (0, "$!");
-        };
-    }
-}
-
 sub use_shm { 1 }
 sub shm_size() { 64 }
 
@@ -199,36 +154,18 @@ do so if Test::Builder is loaded for legacy reasons.
         $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 {
+    my ($ren_ok, $ren_err);
+    my ($ok, $err) = try_sig_mask {
         Storable::store($e, $file);
-        my ($ok, $err) = do_rename("$file", $ready);
-        unless ($ok) {
-            POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked;
-            $self->abort("Could not rename file '$file' -> '$ready': $err");
-        };
-        test2_ipc_set_pending(substr($file, -(shm_size)));
+        ($ren_ok, $ren_err) = do_rename("$file", $ready);
     };
 
-    # 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) {
+    if ($ok) {
+        $self->abort("Could not rename file '$file' -> '$ready': $ren_err") unless $ren_ok;
+        test2_ipc_set_pending(substr($file, -(shm_size)));
+    }
+    else {
         my $src_file = __FILE__;
         $err =~ s{ at \Q$src_file\E.*$}{};
         chomp($err);
@@ -374,7 +311,7 @@ sub waiting {
     require Test2::Event::Waiting;
     $self->send(
         GLOBAL => Test2::Event::Waiting->new(
-            trace => Test2::Util::Trace->new(frame => [caller()]),
+            trace => Test2::EventFacet::Trace->new(frame => [caller()]),
         ),
         'GLOBAL'
     );
@@ -487,7 +424,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 857a923..c460196 100644 (file)
@@ -10,7 +10,7 @@ use Test2::API qw/context run_subtest test2_stack/;
 use Test2::Hub::Interceptor();
 use Test2::Hub::Interceptor::Terminator();
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 BEGIN { require Exporter; our @ISA = qw(Exporter) }
 our @EXPORT = qw{
@@ -21,9 +21,9 @@ our @EXPORT = qw{
 sub ok($;$@) {
     my ($bool, $name, @diag) = @_;
     my $ctx = context();
-    $ctx->ok($bool, $name, \@diag);
-    $ctx->release;
-    return $bool ? 1 : 0;
+
+    return $ctx->pass_and_release($name) if $bool;
+    return $ctx->fail_and_release($name, @diag);
 }
 
 sub is($$;$@) {
@@ -41,18 +41,16 @@ sub is($$;$@) {
         $bool = 1;
     }
 
-    unless ($bool) {
-        $got  = '*NOT DEFINED*' unless defined $got;
-        $want = '*NOT DEFINED*' unless defined $want;
-        unshift @diag => (
-            "GOT:      $got",
-            "EXPECTED: $want",
-        );
-    }
+    return $ctx->pass_and_release($name) if $bool;
 
-    $ctx->ok($bool, $name, \@diag);
-    $ctx->release;
-    return $bool;
+    $got  = '*NOT DEFINED*' unless defined $got;
+    $want = '*NOT DEFINED*' unless defined $want;
+    unshift @diag => (
+        "GOT:      $got",
+        "EXPECTED: $want",
+    );
+
+    return $ctx->fail_and_release($name, @diag);
 }
 
 sub isnt($$;$@) {
@@ -70,12 +68,12 @@ sub isnt($$;$@) {
         $bool = 0;
     }
 
+    return $ctx->pass_and_release($name) if $bool;
+
     unshift @diag => "Strings are the same (they should not be)"
         unless $bool;
 
-    $ctx->ok($bool, $name, \@diag);
-    $ctx->release;
-    return $bool;
+    return $ctx->fail_and_release($name, @diag);
 }
 
 sub like($$;$@) {
@@ -95,9 +93,8 @@ sub like($$;$@) {
         unshift @diag => "Got an undefined value.";
     }
 
-    $ctx->ok($bool, $name, \@diag);
-    $ctx->release;
-    return $bool;
+    return $ctx->pass_and_release($name) if $bool;
+    return $ctx->fail_and_release($name, @diag);
 }
 
 sub unlike($$;$@) {
@@ -118,9 +115,8 @@ sub unlike($$;$@) {
         unshift @diag => "Got an undefined value.";
     }
 
-    $ctx->ok($bool, $name, \@diag);
-    $ctx->release;
-    return $bool;
+    return $ctx->pass_and_release($name) if $bool;
+    return $ctx->fail_and_release($name, @diag);
 }
 
 sub is_deeply($$;$@) {
@@ -129,6 +125,10 @@ sub is_deeply($$;$@) {
 
     no warnings 'once';
     require Data::Dumper;
+
+    # Otherwise numbers might be unquoted
+    local $Data::Dumper::Useperl  = 1;
+
     local $Data::Dumper::Sortkeys = 1;
     local $Data::Dumper::Deparse  = 1;
     local $Data::Dumper::Freezer  = 'XXX';
@@ -147,11 +147,8 @@ sub is_deeply($$;$@) {
 
     my $bool = $g eq $w;
 
-    my $diff;
-
-    $ctx->ok($bool, $name, [$diff ? $diff : ($g, $w), @diag]);
-    $ctx->release;
-    return $bool;
+    return $ctx->pass_and_release($name) if $bool;
+    return $ctx->fail_and_release($name, $g, $w, @diag);
 }
 
 sub diag {
@@ -183,16 +180,13 @@ sub todo {
     my $filter = $hub->pre_filter(
         sub {
             my ($active_hub, $event) = @_;
-
-            # Turn a diag into a note
-            return Test2::Event::Note->new(%$event) if ref($event) eq 'Test2::Event::Diag';
-
-            # Set todo on ok's
-            if ($hub == $active_hub && $event->isa('Test2::Event::Ok')) {
-                $event->set_todo($reason);
-                $event->set_effective_pass(1);
+            if ($active_hub == $hub) {
+                $event->set_todo($reason) if $event->can('set_todo');
+                $event->add_amnesty([todo => $reason]);
+            }
+            else {
+                $event->add_amnesty({tag => 'todo', details => $reason, inherited => 1});
             }
-
             return $event;
         },
         inherit => 1,
@@ -237,7 +231,9 @@ sub tests {
     my ($name, $code) = @_;
     my $ctx = context();
 
-    before_each() if __PACKAGE__->can('before_each');
+    my $be = caller->can('before_each');
+
+    $be->($name) if $be;
 
     my $bool = run_subtest($name, $code, 1);
 
@@ -415,7 +411,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 95f9d77..c0d9342 100644 (file)
@@ -256,6 +256,14 @@ internals.
 
 Fixed in version: 0.15
 
+=item Test::More::Prefix
+
+Worked by applying a role that wrapped C<< Test::Builder->_print_comment >>.
+Fixed by adding an event filter that modifies the message instead when running
+under Test2.
+
+Fixed in version: 0.007
+
 =back
 
 =head2 STILL BROKEN
@@ -298,14 +306,6 @@ something new (Test2) to completely rewrite it in a sane way.
 
 Still broken as of version: 0.32
 
-=item Test::More::Prefix
-
-The current version, 0.005 is broken. A patch has been applied in git, and
-released in 0.006, but a version issue with 0.006 prevents its installation.
-
-Still broken as of version: 0.005
-Potentially fixed in version: 0.006 (not installable)
-
 =item Net::BitTorrent
 
 The tests for this module directly access L<Test::Builder> hash keys. Most, if
@@ -502,7 +502,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 53379d4..51c7fc9 100644 (file)
@@ -2,10 +2,12 @@ package Test2::Util;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
-
+our $VERSION = '1.302096';
 
+use POSIX();
 use Config qw/%Config/;
+use Carp qw/croak/;
+use PerlIO();
 
 our @EXPORT_OK = qw{
     try
@@ -17,9 +19,18 @@ our @EXPORT_OK = qw{
     CAN_REALLY_FORK
     CAN_FORK
 
+    CAN_SIGSYS
+
     IS_WIN32
 
     ipc_separator
+
+    clone_io
+    do_rename do_unlink
+
+    try_sig_mask
+
+    clone_io
 };
 BEGIN { require Exporter; our @ISA = qw(Exporter) }
 
@@ -143,6 +154,113 @@ sub pkg_to_file {
 
 sub ipc_separator() { "~" }
 
+sub _check_for_sig_sys {
+    my $sig_list = shift;
+    return $sig_list =~ m/\bSYS\b/;
+}
+
+BEGIN {
+    if (_check_for_sig_sys($Config{sig_name})) {
+        *CAN_SIGSYS = sub() { 1 };
+    }
+    else {
+        *CAN_SIGSYS = sub() { 0 };
+    }
+}
+
+my %PERLIO_SKIP = (
+    unix => 1,
+    via  => 1,
+);
+
+sub clone_io {
+    my ($fh) = @_;
+    my $fileno = fileno($fh) or croak "Could not get fileno for handle";
+
+    my %seen;
+    open(my $out, '>&', $fileno) or die "Can't dup fileno $fileno: $!";
+    binmode($out, join(":", "", "raw", grep { !$PERLIO_SKIP{$_} and !$seen{$_}++ } PerlIO::get_layers(STDOUT)));
+
+    my $old = select $fh;
+    my $af = $|;
+    select $out;
+    $| = $af;
+    select $old;
+
+    return $out;
+}
+
+BEGIN {
+    if (IS_WIN32) {
+        my $max_tries = 5;
+
+        *do_rename = sub {
+            my ($from, $to) = @_;
+
+            my $err;
+            for (1 .. $max_tries) {
+                return (1) if rename($from, $to);
+                $err = "$!";
+                last if $_ == $max_tries;
+                sleep 1;
+            }
+
+            return (0, $err);
+        };
+        *do_unlink = sub {
+            my ($file) = @_;
+
+            my $err;
+            for (1 .. $max_tries) {
+                return (1) if unlink($file);
+                $err = "$!";
+                last if $_ == $max_tries;
+                sleep 1;
+            }
+
+            return (0, "$!");
+        };
+    }
+    else {
+        *do_rename = sub {
+            my ($from, $to) = @_;
+            return (1) if rename($from, $to);
+            return (0, "$!");
+        };
+        *do_unlink = sub {
+            my ($file) = @_;
+            return (1) if unlink($file);
+            return (0, "$!");
+        };
+    }
+}
+
+sub try_sig_mask(&) {
+    my $code = shift;
+
+    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.
+    }
+
+    my ($ok, $err) = &try($code);
+
+    # If our block was successful we want to restore the old mask.
+    POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked;
+
+    return ($ok, $err);
+}
+
 1;
 
 __END__
@@ -204,6 +322,42 @@ otherwise it returns 0.
 
 Convert a package name to a filename.
 
+=item ($ok, $err) = do_rename($old_name, $new_name)
+
+Rename a file, this wraps C<rename()> in a way that makes it more reliable
+cross-platform when trying to rename files you recently altered.
+
+=item ($ok, $err) = do_unlink($filename)
+
+Unlink a file, this wraps C<unlink()> in a way that makes it more reliable
+cross-platform when trying to unlink files you recently altered.
+
+=item ($ok, $err) = try_sig_mask { ... }
+
+Complete an action with several signals masked, they will be unmasked at the
+end allowing any signals that were intercepted to get handled.
+
+This is primarily used when you need to make several actions atomic (against
+some signals anyway).
+
+Signals that are intercepted:
+
+=over 4
+
+=item SIGINT
+
+=item SIGALRM
+
+=item SIGHUP
+
+=item SIGTERM
+
+=item SIGUSR1
+
+=item SIGUSR2
+
+=back
+
 =back
 
 =head1 NOTES && CAVEATS
@@ -248,7 +402,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index f9c611e..b3f3884 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta;
 use strict;
 use warnings;
 
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 
 use Carp qw/croak/;
@@ -172,7 +172,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
diff --git a/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm b/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm
new file mode 100644 (file)
index 0000000..5ee96e3
--- /dev/null
@@ -0,0 +1,114 @@
+package Test2::Util::Facets2Legacy;
+use strict;
+use warnings;
+
+our $VERSION = '1.302096';
+
+use Carp qw/croak confess/;
+use Scalar::Util qw/blessed/;
+
+use base 'Exporter';
+our @EXPORT_OK = qw{
+    causes_fail
+    diagnostics
+    global
+    increments_count
+    no_display
+    sets_plan
+    subtest_id
+    summary
+    terminate
+};
+our %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
+
+our $CYCLE_DETECT = 0;
+sub _get_facet_data {
+    my $in = shift;
+
+    if (blessed($in) && $in->isa('Test2::Event')) {
+        confess "Cycle between Facets2Legacy and $in\->facet_data() (Did you forget to override the facet_data() method?)"
+            if $CYCLE_DETECT;
+
+        local $CYCLE_DETECT = 1;
+        return $in->facet_data;
+    }
+
+    return $in if ref($in) eq 'HASH';
+
+    croak "'$in' Does not appear to be either a Test::Event or an EventFacet hashref";
+}
+
+sub causes_fail {
+    my $facet_data = _get_facet_data(shift @_);
+
+    return 1 if $facet_data->{errors} && grep { $_->{fail} } @{$facet_data->{errors}};
+
+    if (my $control = $facet_data->{control}) {
+        return 1 if $control->{halt};
+        return 1 if $control->{terminate};
+    }
+
+    return 0 if $facet_data->{amnesty} && @{$facet_data->{amnesty}};
+    return 1 if $facet_data->{assert} && !$facet_data->{assert}->{pass};
+    return 0;
+}
+
+sub diagnostics {
+    my $facet_data = _get_facet_data(shift @_);
+    return 1 if $facet_data->{errors} && @{$facet_data->{errors}};
+    return 0 unless $facet_data->{info} && @{$facet_data->{info}};
+    return (grep { $_->{debug} } @{$facet_data->{info}}) ? 1 : 0;
+}
+
+sub global {
+    my $facet_data = _get_facet_data(shift @_);
+    return 0 unless $facet_data->{control};
+    return $facet_data->{control}->{global};
+}
+
+sub increments_count {
+    my $facet_data = _get_facet_data(shift @_);
+    return $facet_data->{assert} ? 1 : 0;
+}
+
+sub no_display {
+    my $facet_data = _get_facet_data(shift @_);
+    return 0 unless $facet_data->{about};
+    return $facet_data->{about}->{no_display};
+}
+
+sub sets_plan {
+    my $facet_data = _get_facet_data(shift @_);
+    my $plan = $facet_data->{plan} or return;
+    my @out = ($plan->{count} || 0);
+
+    if ($plan->{skip}) {
+        push @out => 'SKIP';
+        push @out => $plan->{details} if defined $plan->{details};
+    }
+    elsif ($plan->{none}) {
+        push @out => 'NO PLAN'
+    }
+
+    return @out;
+}
+
+sub subtest_id {
+    my $facet_data = _get_facet_data(shift @_);
+    return undef unless $facet_data->{parent};
+    return $facet_data->{parent}->{hid};
+}
+
+sub summary {
+    my $facet_data = _get_facet_data(shift @_);
+    return '' unless $facet_data->{about} && $facet_data->{about}->{details};
+    return $facet_data->{about}->{details};
+}
+
+sub terminate {
+    my $facet_data = _get_facet_data(shift @_);
+    return undef unless $facet_data->{control};
+    return $facet_data->{control}->{terminate};
+}
+
+1;
index 76041ef..138ac2b 100644 (file)
@@ -12,8 +12,11 @@ use warnings;
 
 {
     no warnings 'once';
-    $Test2::Util::HashBase::VERSION = '0.002';
+    $Test2::Util::HashBase::VERSION = '0.005';
     *Test2::Util::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS;
+    *Test2::Util::HashBase::ATTR_LIST = \%Object::HashBase::ATTR_LIST;
+    *Test2::Util::HashBase::VERSION   = \%Object::HashBase::VERSION;
+    *Test2::Util::HashBase::CAN_CACHE = \%Object::HashBase::CAN_CACHE;
 }
 
 
@@ -46,9 +49,16 @@ sub import {
     my $class = shift;
     my $into  = caller;
 
-    my $isa       = _isa($into);
+    # Make sure we list the OLDEST version used to create this class.
+    $Test2::Util::HashBase::VERSION{$into} = $Test2::Util::HashBase::VERSION
+        if !$Test2::Util::HashBase::VERSION{$into}
+        || $Test2::Util::HashBase::VERSION{$into} > $Test2::Util::HashBase::VERSION;
+
+    my $isa = _isa($into);
+    my $attr_list = $Test2::Util::HashBase::ATTR_LIST{$into} ||= [];
     my $attr_subs = $Test2::Util::HashBase::ATTR_SUBS{$into} ||= {};
-    my %subs      = (
+
+    my %subs = (
         ($into->can('new') ? () : (new => \&_new)),
         (map %{$Test2::Util::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 .. $#$isa]),
         (
@@ -56,12 +66,13 @@ sub import {
                 my $p = substr($_, 0, 1);
                 my $x = $_;
                 substr($x, 0, 1) = '' if $STRIP{$p};
+                push @$attr_list => $x;
                 my ($sub, $attr) = (uc $x, $x);
                 $sub => ($attr_subs->{$sub} = sub() { $attr }),
-                $attr => sub { $_[0]->{$attr} },
-                  $p eq '-' ? ("set_$attr" => sub { Carp::croak("'$attr' is read-only") })
-                : $p eq '^' ? ("set_$attr" => sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] })
-                :             ("set_$attr" => sub { $_[0]->{$attr} = $_[1] }),
+                    $attr => sub { $_[0]->{$attr} },
+                      $p eq '-' ? ("set_$attr" => sub { Carp::croak("'$attr' is read-only") })
+                    : $p eq '^' ? ("set_$attr" => sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] })
+                    : ("set_$attr" => sub { $_[0]->{$attr} = $_[1] }),
             } @_
         ),
     );
@@ -70,10 +81,65 @@ sub import {
     *{"$into\::$_"} = $subs{$_} for keys %subs;
 }
 
+sub attr_list {
+    my $class = shift;
+
+    my $isa = _isa($class);
+
+    my %seen;
+    my @list = grep { !$seen{$_}++ } map {
+        my @out;
+
+        if (0.004 > ($Test2::Util::HashBase::VERSION{$_} || 0)) {
+            Carp::carp("$_ uses an inlined version of Test2::Util::HashBase too old to support attr_list()");
+        }
+        else {
+            my $list = $Test2::Util::HashBase::ATTR_LIST{$_};
+            @out = $list ? @$list : ()
+        }
+
+        @out;
+    } reverse @$isa;
+
+    return @list;
+}
+
 sub _new {
-    my ($class, %params) = @_;
-    my $self = bless \%params, $class;
-    $self->init if $self->can('init');
+    my $class = shift;
+
+    my $self;
+
+    if (@_ == 1) {
+        my $arg = shift;
+        my $type = ref($arg);
+
+        if ($type eq 'HASH') {
+            $self = bless({%$arg}, $class)
+        }
+        else {
+            Carp::croak("Not sure what to do with '$type' in $class constructor")
+                unless $type eq 'ARRAY';
+
+            my %proto;
+            my @attributes = attr_list($class);
+            while (@$arg) {
+                my $val = shift @$arg;
+                my $key = shift @attributes or Carp::croak("Too many arguments for $class constructor");
+                $proto{$key} = $val;
+            }
+
+            $self = bless(\%proto, $class);
+        }
+    }
+    else {
+        $self = bless({@_}, $class);
+    }
+
+    $Test2::Util::HashBase::CAN_CACHE{$class} = $self->can('init')
+        unless exists $Test2::Util::HashBase::CAN_CACHE{$class};
+
+    $self->init if $Test2::Util::HashBase::CAN_CACHE{$class};
+
     $self;
 }
 
@@ -139,7 +205,10 @@ use it:
     use warnings;
     use My::Class;
 
-    my $one = My::Class->new(foo => 'MyFoo', bar => 'MyBar');
+    # These are all functionally identical
+    my $one   = My::Class->new(foo => 'MyFoo', bar => 'MyBar');
+    my $two   = My::Class->new({foo => 'MyFoo', bar => 'MyBar'});
+    my $three = My::Class->new(['MyFoo', 'MyBar']);
 
     # Accessors!
     my $foo = $one->foo;    # 'MyFoo'
@@ -180,9 +249,13 @@ script.
 
 =over 4
 
-=item $it = $class->new(@VALUES)
+=item $it = $class->new(%PAIRS)
+
+=item $it = $class->new(\%PAIRS)
 
-Create a new instance using key/value pairs.
+=item $it = $class->new(\@ORDERED_VALUES)
+
+Create a new instance.
 
 HashBase will not export C<new()> if there is already a C<new()> method in your
 packages inheritance chain.
@@ -204,6 +277,21 @@ This makes it so that HashBase sees that you have your own C<new()> method.
 Alternatively you can define the method before loading HashBase instead of just
 declaring it, but that scatters your use statements.
 
+The most common way to create an object is to pass in key/value pairs where
+each key is an attribute and each value is what you want assigned to that
+attribute. No checking is done to verify the attributes or values are valid,
+you may do that in C<init()> if desired.
+
+If you would like, you can pass in a hashref instead of pairs. When you do so
+the hashref will be copied, and the copy will be returned blessed as an object.
+There is no way to ask HashBase to bless a specific hashref.
+
+In some cases an object may only have 1 or 2 attributes, in which case a
+hashref may be too verbose for your liking. In these cases you can pass in an
+arrayref with only values. The values will be assigned to attributes in the
+order the attributes were listed. When there is inheritance involved the
+attributes from parent classes will come before subclasses.
+
 =back
 
 =head2 HOOKS
@@ -215,10 +303,18 @@ declaring it, but that scatters your use statements.
 This gives you the chance to set some default values to your fields. The only
 argument is C<$self> with its indexes already set from the constructor.
 
+B<Note:> Test2::Util::HashBase checks for an init using C<< $class->can('init') >>
+during construction. It DOES NOT call C<can()> on the created object. Also note
+that the result of the check is cached, it is only ever checked once, the first
+time an instance of your class is created. This means that adding an C<init()>
+method AFTER the first construction will result in it being ignored.
+
 =back
 
 =head1 ACCESSORS
 
+=head2 READ/WRITE
+
 To generate accessors you list them when using the module:
 
     use Test2::Util::HashBase qw/foo/;
@@ -246,6 +342,32 @@ and similar typos. It will not help you if you forget to prefix the '+' though.
 
 =back
 
+=head2 READ ONLY
+
+    use Test2::Util::HashBase qw/-foo/;
+
+=over 4
+
+=item set_foo()
+
+Throws an exception telling you the attribute is read-only. This is exported to
+override any active setters for the attribute in a parent class.
+
+=back
+
+=head2 DEPRECATED SETTER
+
+    use Test2::Util::HashBase qw/^foo/;
+
+=over 4
+
+=item set_foo()
+
+This will set the value, but it will also warn you that the method is
+deprecated.
+
+=back
+
 =head1 SUBCLASSING
 
 You can subclass an existing HashBase class.
@@ -256,6 +378,27 @@ You can subclass an existing HashBase class.
 The base class is added to C<@ISA> for you, and all constants from base classes
 are added to subclasses automatically.
 
+=head1 GETTING A LIST OF ATTRIBUTES FOR A CLASS
+
+Test2::Util::HashBase provides a function for retrieving a list of attributes for an
+Test2::Util::HashBase class.
+
+=over 4
+
+=item @list = Test2::Util::HashBase::attr_list($class)
+
+=item @list = $class->Test2::Util::HashBase::attr_list()
+
+Either form above will work. This will return a list of attributes defined on
+the object. This list is returned in the attribute definition order, parent
+class attributes are listed before subclass attributes. Duplicate attributes
+will be removed before the list is returned.
+
+B<Note:> This list is used in the C<< $class->new(\@ARRAY) >> constructor to
+determine the attribute to which each value will be paired.
+
+=back
+
 =head1 SOURCE
 
 The source code repository for HashBase can be found at
@@ -279,7 +422,7 @@ F<http://github.com/Test-More/HashBase/>.
 
 =head1 COPYRIGHT
 
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 0f10bcb..50c3405 100644 (file)
@@ -1,66 +1,8 @@
 package Test2::Util::Trace;
-use strict;
-use warnings;
+require Test2::EventFacet::Trace;
+@ISA = ('Test2::EventFacet::Trace');
 
-our $VERSION = '1.302073';
-
-
-use Test2::Util qw/get_tid pkg_to_file/;
-
-use Carp qw/confess/;
-
-use Test2::Util::HashBase qw{frame detail pid tid};
-
-sub init {
-    confess "The 'frame' attribute is required"
-        unless $_[0]->{+FRAME};
-
-    $_[0]->{+PID} = $$        unless defined $_[0]->{+PID};
-    $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
-}
-
-sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
-
-sub debug {
-    my $self = shift;
-    return $self->{+DETAIL} if $self->{+DETAIL};
-    my ($pkg, $file, $line) = $self->call;
-    return "at $file line $line";
-}
-
-sub alert {
-    my $self = shift;
-    my ($msg) = @_;
-    warn $msg . ' ' . $self->debug . ".\n";
-}
-
-sub throw {
-    my $self = shift;
-    my ($msg) = @_;
-    die $msg . ' ' . $self->debug . ".\n";
-}
-
-sub call { @{$_[0]->{+FRAME}} }
-
-sub package { $_[0]->{+FRAME}->[0] }
-sub file    { $_[0]->{+FRAME}->[1] }
-sub line    { $_[0]->{+FRAME}->[2] }
-sub subname { $_[0]->{+FRAME}->[3] }
-
-sub from_json {
-    my $class = shift;
-       my %p     = @_;
-
-    my $trace_pkg = delete $p{__PACKAGE__};
-       require(pkg_to_file($trace_pkg));
-
-    return $trace_pkg->new(%p);
-}
-
-sub TO_JSON {
-    my $self = shift;
-    return {%$self, __PACKAGE__ => ref $self};
-}
+our $VERSION = '1.302096';
 
 1;
 
@@ -72,86 +14,12 @@ __END__
 
 =head1 NAME
 
-Test2::Util::Trace - Debug information for events
+Test2::Util::Trace - Legacy wrapper fro L<Test2::EventFacet::Trace>.
 
 =head1 DESCRIPTION
 
-The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to
-have access to information about where they were created.  This object
-represents that information.
-
-=head1 SYNOPSIS
-
-    use Test2::Util::Trace;
-
-    my $trace = Test2::Util::Trace->new(
-        frame => [$package, $file, $line, $subname],
-    );
-
-=head1 METHODS
-
-=over 4
-
-=item $trace->set_detail($msg)
-
-=item $msg = $trace->detail
-
-Used to get/set a custom trace message that will be used INSTEAD of
-C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
-
-=item $str = $trace->debug
-
-Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set
-then its value will be returned instead.
-
-=item $trace->alert($MESSAGE)
-
-This issues a warning at the frame (filename and line number where
-errors should be reported).
-
-=item $trace->throw($MESSAGE)
-
-This throws an exception at the frame (filename and line number where
-errors should be reported).
-
-=item $frame = $trace->frame()
-
-Get the call frame arrayref.
-
-=item ($package, $file, $line, $subname) = $trace->call()
-
-Get the caller details for the debug-info. This is where errors should be
-reported.
-
-=item $pkg = $trace->package
-
-Get the debug-info package.
-
-=item $file = $trace->file
-
-Get the debug-info filename.
-
-=item $line = $trace->line
-
-Get the debug-info line number.
-
-=item $subname = $trace->subname
-
-Get the debug-info subroutine name.
-
-=item $hashref = $t->TO_JSON
-
-This returns a hashref suitable for passing to the C<<
-Test2::Util::Trace->from_json >> constructor. It is intended for use with the
-L<JSON> family of modules, which will look for a C<TO_JSON> method when
-C<convert_blessed> is true.
-
-=item $t = Test2::Util::Trace->from_json(%$hashref)
-
-Given the hash of data returned by C<< $t->TO_JSON >>, this method returns a
-new trace object of the appropriate subclass.
-
-=back
+All the functionality for this class has been moved to
+L<Test2::EventFacet::Trace>.
 
 =head1 SOURCE
 
index 143885d..04c38d8 100644 (file)
@@ -1,5 +1,5 @@
 package ok;
-our $VERSION = '1.302073';
+our $VERSION = '1.302096';
 
 use strict;
 use Test::More ();
similarity index 60%
rename from cpan/Test-Simple/t/Test2/modules/Util/HashBase.t
rename to cpan/Test-Simple/t/HashBase.t
index 7f1824a..aa4d435 100644 (file)
@@ -90,7 +90,7 @@ BEGIN {
 
     package
         main::HBase::Wrapped;
-    use Test2::Util::HashBase qw/foo bar/;
+    use Test2::Util::HashBase qw/foo bar dup/;
 
     my $foo = __PACKAGE__->can('foo');
     no warnings 'redefine';
@@ -107,7 +107,7 @@ BEGIN {
     package
         main::HBase::Wrapped::Inherit;
     use base 'main::HBase::Wrapped';
-    use Test2::Util::HashBase;
+    use Test2::Util::HashBase qw/baz dup/;
 }
 
 my $o = main::HBase::Wrapped::Inherit->new(foo => 1);
@@ -152,6 +152,84 @@ like(exception { $ro->set_bar('xxx') }, qr/'bar' is read-only/, "Cannot set bar"
 my $warnings = warnings { is($ro->set_baz('xxx'), 'xxx', 'set baz') };
 like($warnings->[0], qr/set_baz\(\) is deprecated/, "Deprecation warning");
 
+
+
+is_deeply(
+    [Test2::Util::HashBase::attr_list('main::HBase::Wrapped::Inherit')],
+    [qw/foo bar dup baz/],
+    "Got a list of attributes in order starting from base class, duplicates removed",
+);
+
+my $x = main::HBase::Wrapped::Inherit->new(foo => 1, baz => 2);
+is($x->foo, 1, "set foo via pairs");
+is($x->baz, 2, "set baz via pairs");
+
+# Now with hashref
+my $y = main::HBase::Wrapped::Inherit->new({foo => 1, baz => 2});
+is($y->foo, 1, "set foo via hashref");
+is($y->baz, 2, "set baz via hashref");
+
+# Now with hashref
+my $z = main::HBase::Wrapped::Inherit->new([
+    1, # foo
+    2, # bar
+    3, # dup
+    4, # baz
+]);
+is($z->foo, 1, "set foo via arrayref");
+is($z->baz, 4, "set baz via arrayref");
+
+like(
+    exception { main::HBase::Wrapped::Inherit->new([1 .. 10]) },
+    qr/Too many arguments for main::HBase::Wrapped::Inherit constructor/,
+    "Too many args in array form"
+);
+
+
+my $CAN_COUNT = 0;
+my $CAN_COUNT2 = 0;
+my $INIT_COUNT = 0;
+BEGIN {
+    $INC{'Object/HashBase/Test/HBase3.pm'} = __FILE__;
+    package
+        main::HBase3;
+    use Test2::Util::HashBase qw/foo/;
+
+    sub can {
+        my $self = shift;
+        $CAN_COUNT++;
+        $self->SUPER::can(@_);
+    }
+
+    $INC{'Object/HashBase/Test/HBase4.pm'} = __FILE__;
+    package
+        main::HBase4;
+    use Test2::Util::HashBase qw/foo/;
+
+    sub can {
+        my $self = shift;
+        $CAN_COUNT2++;
+        $self->SUPER::can(@_);
+    }
+
+    sub init { $INIT_COUNT++ }
+}
+
+is($CAN_COUNT, 0, "->can has not been called yet");
+my $it = main::HBase3->new;
+is($CAN_COUNT, 1, "->can has been called once to check for init");
+$it = main::HBase3->new;
+is($CAN_COUNT, 1, "->can was not called again, we cached it");
+
+is($CAN_COUNT2, 0, "->can has not been called yet");
+is($INIT_COUNT, 0, "->init has not been called yet");
+$it = main::HBase4->new;
+is($CAN_COUNT2, 1, "->can has been called once to check for init");
+is($INIT_COUNT, 1, "->init has been called once");
+$it = main::HBase4->new;
+is($CAN_COUNT2, 1, "->can was not called again, we cached it");
+is($INIT_COUNT, 2, "->init has been called again");
+
 done_testing;
 
 1;
index 3a0bae2..ef5e077 100644 (file)
@@ -16,18 +16,22 @@ use Test::Builder::NoOutput;
 
 my $tb = Test::Builder::NoOutput->create;
 
+# $tb methods expect to be wrapped in at least 1 sub
+sub done_testing { $tb->done_testing(@_) }
+sub ok { $tb->ok(@_) }
+
 {
     # Normalize test output
     local $ENV{HARNESS_ACTIVE};
 
-    $tb->ok(1);
-    $tb->ok(1);
-    $tb->ok(1);
+    ok(1);
+    ok(1);
+    ok(1);
 
 #line 24
-    $tb->done_testing(3);
-    $tb->done_testing;
-    $tb->done_testing;
+    done_testing(3);
+    done_testing;
+    done_testing;
 }
 
 my $Test = Test::Builder->new;
index 8208635..54e7f42 100644 (file)
@@ -18,17 +18,22 @@ use Test::Builder::NoOutput;
 
 my $tb = Test::Builder::NoOutput->create;
 
+# TB methods expect to be wrapped
+sub ok { $tb->ok(@_) }
+sub plan { $tb->plan(@_) }
+sub done_testing { $tb->done_testing(@_) }
+
 {
     # Normalize test output
     local $ENV{HARNESS_ACTIVE};
 
-    $tb->plan( tests => 3 );
-    $tb->ok(1);
-    $tb->ok(1);
-    $tb->ok(1);
+    plan( tests => 3 );
+    ok(1);
+    ok(1);
+    ok(1);
 
 #line 24
-    $tb->done_testing(2);
+    done_testing(2);
 }
 
 my $Test = Test::Builder->new;
index 594402e..f084571 100644 (file)
@@ -3,8 +3,9 @@ use strict;
 use warnings;
 
 use Test2::Util qw/CAN_FORK/;
+
 BEGIN {
-    unless(CAN_FORK) {
+    unless (CAN_FORK) {
         require Test::More;
         Test::More->import(skip_all => "fork is not supported");
     }
@@ -20,20 +21,22 @@ $b->reset;
 $b->plan('tests' => 2);
 
 my $pipe = IO::Pipe->new;
-if ( my $pid = fork ) {
-  $pipe->reader;
-  my ($one, $two) = <$pipe>;
-  $b->like($one, qr/ok 1/, "ok 1 from child");
-  $b->like($two, qr/1\.\.1/, "1..1 from child");
-  waitpid($pid, 0);
+if (my $pid = fork) {
+    $pipe->reader;
+    my ($one, $two) = <$pipe>;
+    $b->like($one, qr/ok 1/,   "ok 1 from child");
+    $b->like($two, qr/1\.\.1/, "1..1 from child");
+    waitpid($pid, 0);
 }
 else {
-  $pipe->writer;
-  $b->reset;
-  $b->no_plan;
-  $b->output($pipe);
-  $b->ok(1);
-  $b->done_testing;
+    require Test::Builder::Formatter;
+    $b->{Stack}->top->format(Test::Builder::Formatter->new());
+    $pipe->writer;
+    $b->reset;
+    $b->no_plan;
+    $b->output($pipe);
+    $b->ok(1);
+    $b->done_testing;
 }
 
 
index d335aad..d0aed0c 100644 (file)
@@ -5,7 +5,9 @@ use lib 't/lib';
 
 # We're going to need to override exit() later
 BEGIN {
-    *CORE::GLOBAL::exit = sub(;$) {
+    require Test2::Hub;
+    no warnings 'redefine';
+    *Test2::Hub::terminate = sub {
         my $status = @_ ? 0 : shift;
         CORE::exit $status;
     };
@@ -61,22 +63,19 @@ use Test::Builder::NoOutput;
     ok $tb->is_passing, "  and after the ending";
 }
 
-
 # is_passing() vs skip_all
 {
     my $tb = Test::Builder::NoOutput->create;
 
     {
         no warnings 'redefine';
-        local *CORE::GLOBAL::exit = sub {
-            return 1;
-        };
+        local *Test2::Hub::terminate = sub { 1 };
+
         $tb->plan( "skip_all" );
     }
     ok $tb->is_passing, "Passing with skip_all";
 }
 
-
 # is_passing() vs done_testing(#)
 {
     my $tb = Test::Builder::NoOutput->create;
index 6fa538a..ed154a7 100644 (file)
@@ -1,8 +1,13 @@
 #!/usr/bin/perl -w
 
-use Test::More 'no_diag', tests => 2;
+use Test::More 'no_diag';
+
+plan 'skip_all' => "This test cannot be run with the current formatter"
+    unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter');
 
 pass('foo');
 diag('This should not be displayed');
 
 is(Test::More->builder->no_diag, 1);
+
+done_testing;
index c3aaf44..5fd2da6 100644 (file)
@@ -1,5 +1,6 @@
 use strict;
 use warnings;
+# HARNESS-NO-STREAM
 
 use Test2::Util qw/CAN_THREAD/;
 BEGIN {
@@ -20,6 +21,9 @@ use Test2::IPC;
 use threads;
 use Test::More;
 
+plan 'skip_all' => "This test cannot be run with the current formatter"
+    unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter');
+
 ok 1 for (1 .. 2);
 
 # used to reset the counter after thread finishes
@@ -46,7 +50,7 @@ my $subtest_out = async {
 }
 ->join;
 
-$subtest_out =~ s/^/   /gm;
+$subtest_out =~ s/^/    /gm;
 print $subtest_out;
 
 # reset as if the thread never "said" anything
index a0c8b8e..570ca9d 100644 (file)
@@ -9,6 +9,7 @@ use File::Basename qw(dirname);
 use File::Spec qw();
 
 my $file = File::Spec->join(dirname(__FILE__), 'tbt_09do_script.pl');
+$file = "./$file" unless $file =~ m{^\.?/};
 my $done = do $file;
 ok(defined($done), 'do succeeded') or do {
     if ($@) {
index d1c3dce..94f12ac 100644 (file)
@@ -1,4 +1,6 @@
 #!/usr/bin/perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index a339634..02551d0 100644 (file)
@@ -1,4 +1,6 @@
 #!/usr/bin/perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 # Test::More should not print anything when Perl is only doing
 # a compile as with the -c flag or B::Deparse or perlcc.
index c26e86b..af929cb 100644 (file)
@@ -1,4 +1,6 @@
 #!perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 55a0007..ac82aae 100644 (file)
@@ -16,35 +16,40 @@ use Test::Builder;
 use Test::Builder::NoOutput;
 use Test::Simple;
 
+# TB methods expect to be wrapped
+my $ok           = sub { shift->ok(@_) };
+my $plan         = sub { shift->plan(@_) };
+my $done_testing = sub { shift->done_testing(@_) };
+
 my $TB   = Test::Builder->new;
 my $test = Test::Builder::NoOutput->create;
-$test->plan( tests => 3 );
+$test->$plan( tests => 3 );
 
 local $ENV{HARNESS_ACTIVE} = 0;
 
-$test->ok(1, 'Foo');
+$test->$ok(1, 'Foo');
 $TB->is_eq($test->read(), <<END);
 1..3
 ok 1 - Foo
 END
 
 #line 30
-$test->ok(0, 'Bar');
+$test->$ok(0, 'Bar');
 $TB->is_eq($test->read(), <<END);
 not ok 2 - Bar
 #   Failed test 'Bar'
 #   at $0 line 30.
 END
 
-$test->ok(1, 'Yar');
-$test->ok(1, 'Car');
+$test->$ok(1, 'Yar');
+$test->$ok(1, 'Car');
 $TB->is_eq($test->read(), <<END);
 ok 3 - Yar
 ok 4 - Car
 END
 
 #line 45
-$test->ok(0, 'Sar');
+$test->$ok(0, 'Sar');
 $TB->is_eq($test->read(), <<END);
 not ok 5 - Sar
 #   Failed test 'Sar'
@@ -57,4 +62,4 @@ $TB->is_eq($test->read(), <<END);
 # Looks like you failed 2 tests of 5 run.
 END
 
-$TB->done_testing(5);
+$TB->$done_testing(5);
index d77404e..a1a15a6 100644 (file)
@@ -1,4 +1,6 @@
 #!/usr/bin/perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 6545507..4ec99ae 100644 (file)
@@ -1,4 +1,6 @@
 #!/usr/bin/perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
@@ -25,12 +27,10 @@ require Test::Builder;
 my $TB = Test::Builder->create;
 $TB->plan(tests => 4);
 
-
 require Test::Simple::Catch;
 my($out, $err) = Test::Simple::Catch::caught();
 local $ENV{HARNESS_ACTIVE} = 0;
 
-
 package main;
 
 require Test::More;
index 5cb373e..3d28fbb 100644 (file)
@@ -1,4 +1,6 @@
 #!perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index ccf0c74..ee8f1b6 100644 (file)
@@ -20,19 +20,24 @@ local $ENV{HARNESS_ACTIVE} = 0;
 use Test::Builder;
 use Test::Builder::NoOutput;
 
+# TB methods expect to be wrapped
+my $ok           = sub { shift->ok(@_) };
+my $plan         = sub { shift->plan(@_) };
+my $done_testing = sub { shift->done_testing(@_) };
+
 my $Test = Test::Builder->new;
 
 # Set up a builder to record some failing tests.
 {
     my $tb = Test::Builder::NoOutput->create;
-    $tb->plan( tests => 5 );
+    $tb->$plan( tests => 5 );
 
 #line 28
-    $tb->ok( 1, 'passing' );
-    $tb->ok( 2, 'passing still' );
-    $tb->ok( 3, 'still passing' );
-    $tb->ok( 0, 'oh no!' );
-    $tb->ok( 0, 'damnit' );
+    $tb->$ok( 1, 'passing' );
+    $tb->$ok( 2, 'passing still' );
+    $tb->$ok( 3, 'still passing' );
+    $tb->$ok( 0, 'oh no!' );
+    $tb->$ok( 0, 'damnit' );
     $tb->_ending;
 
     $Test->is_eq($tb->read('out'), <<OUT);
@@ -52,5 +57,5 @@ OUT
 # Looks like you failed 2 tests of 5.
 ERR
 
-    $Test->done_testing(2);
+    $Test->$done_testing(2);
 }
index 61d7c08..ddab4fb 100644 (file)
@@ -18,15 +18,20 @@ local $ENV{HARNESS_ACTIVE} = 0;
 use Test::Builder;
 use Test::Builder::NoOutput;
 
+# TB methods expect to be wrapped
+my $ok           = sub { shift->ok(@_) };
+my $plan         = sub { shift->plan(@_) };
+my $done_testing = sub { shift->done_testing(@_) };
+
 my $Test = Test::Builder->new;
 
 {
     my $tb = Test::Builder::NoOutput->create;
 
-    $tb->plan( tests => 1 );
+    $tb->$plan( tests => 1 );
 
 #line 28
-    $tb->ok(0);
+    $tb->$ok(0);
     $tb->_ending;
 
     $Test->is_eq($tb->read('out'), <<OUT);
@@ -39,5 +44,5 @@ OUT
 # Looks like you failed 1 test of 1.
 ERR
 
-    $Test->done_testing(2);
+    $Test->$done_testing(2);
 }
index 3b8f1fa..a48533c 100644 (file)
@@ -1,4 +1,6 @@
+# HARNESS-NO-STREAM
 # HARNESS-NO-PRELOAD
+
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
diff --git a/cpan/Test-Simple/t/Legacy/no_log_results.t b/cpan/Test-Simple/t/Legacy/no_log_results.t
new file mode 100644 (file)
index 0000000..859e120
--- /dev/null
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+sub it {
+    my $tb = Test::Builder->new;
+    $tb->no_log_results;
+
+    ok(1, "sample");
+    ok(2, "sample");
+
+    is_deeply([$tb->details], [], "no details were logged");
+}
+
+it();
+subtest it => \&it;
+
+done_testing;
index 5f392e4..559dcfa 100644 (file)
@@ -14,12 +14,17 @@ use Test::More tests => 7;
 
 my $tb = Test::Builder->create;
 
+# TB methods expect to be wrapped
+my $ok           = sub { shift->ok(@_) };
+my $plan         = sub { shift->plan(@_) };
+my $done_testing = sub { shift->done_testing(@_) };
+
 #line 20
-ok !eval { $tb->plan(tests => undef) };
+ok !eval { $tb->$plan(tests => undef) };
 is($@, "Got an undefined number of tests at $0 line 20.\n");
 
 #line 24
-ok !eval { $tb->plan(tests => 0) };
+ok !eval { $tb->$plan(tests => 0) };
 is($@, "You said to run 0 tests at $0 line 24.\n");
 
 {
@@ -27,7 +32,7 @@ is($@, "You said to run 0 tests at $0 line 24.\n");
     local $SIG{__WARN__} = sub { $warning .= join '', @_ };
 
 #line 31
-    ok $tb->plan(no_plan => 1);
+    ok $tb->$plan(no_plan => 1);
     is( $warning, "no_plan takes no arguments at $0 line 31.\n" );
     is $tb->has_plan, 'no_plan';
 }
index 997add5..12c37c6 100644 (file)
@@ -1,4 +1,6 @@
 #!perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index f2ea9fb..9d37c3b 100644 (file)
@@ -1,4 +1,5 @@
 #!perl -w
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
@@ -42,7 +43,6 @@ SKIP: {
     is( $line || '', '',      '  or line' );
 }
 
-
 SKIP: {
     skip $Why, 2 if 1;
 
index bc77325..86a50cb 100644 (file)
@@ -1,4 +1,6 @@
 #!/usr/bin/perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
@@ -10,14 +12,20 @@ BEGIN {
     }
 }
 
+my $goto = 0;
 my $Exit_Code;
 BEGIN {
-    *CORE::GLOBAL::exit = sub { $Exit_Code = shift; goto XXX};
+    *CORE::GLOBAL::exit = sub { $Exit_Code = shift; goto XXX if $goto; CORE::exit($Exit_Code)};
 }
 
 use Test::Builder;
 use Test::More;
 
+my $skip = ref(Test::Builder->new->{Stack}->top->format) ne 'Test::Builder::Formatter';
+plan skip_all => "This test cannot be run with the current formatter"
+    if $skip;
+
+$goto = 1;
 my $output;
 my $TB = Test::More->builder;
 $TB->output(\$output);
index 4850571..44d370e 100644 (file)
@@ -17,27 +17,33 @@ use Test::Builder::NoOutput;
 
 use Test::More tests => 12;
 
+# TB Methods expect to be wrapped.
+my $ok   = sub { shift->ok(@_) };
+my $plan = sub { shift->plan(@_) };
+my $diag = sub { shift->diag(@_) };
+my $finalize = sub { shift->finalize(@_) };
+
 # Formatting may change if we're running under Test::Harness.
 $ENV{HARNESS_ACTIVE} = 0;
 
 {
     my $tb = Test::Builder::NoOutput->create;
 
-    $tb->plan( tests => 7 );
+    $tb->$plan( tests => 7 );
     for( 1 .. 3 ) {
-        $tb->ok( $_, "We're on $_" );
-        $tb->diag("We ran $_");
+        $tb->$ok( $_, "We're on $_" );
+        $tb->$diag("We ran $_");
     }
     {
         my $indented = $tb->child;
-        $indented->plan('no_plan');
-        $indented->ok( 1, "We're on 1" );
-        $indented->ok( 1, "We're on 2" );
-        $indented->ok( 1, "We're on 3" );
-        $indented->finalize;
+        $indented->$plan('no_plan');
+        $indented->$ok( 1, "We're on 1" );
+        $indented->$ok( 1, "We're on 2" );
+        $indented->$ok( 1, "We're on 3" );
+        $indented->$finalize;
     }
     for( 7, 8, 9 ) {
-        $tb->ok( $_, "We're on $_" );
+        $tb->$ok( $_, "We're on $_" );
     }
 
     is $tb->read, <<"END", 'Output should nest properly';
@@ -61,27 +67,27 @@ END
 {
     my $tb = Test::Builder::NoOutput->create;
 
-    $tb->plan('no_plan');
+    $tb->$plan('no_plan');
     for( 1 .. 1 ) {
-        $tb->ok( $_, "We're on $_" );
-        $tb->diag("We ran $_");
+        $tb->$ok( $_, "We're on $_" );
+        $tb->$diag("We ran $_");
     }
     {
         my $indented = $tb->child;
-        $indented->plan('no_plan');
-        $indented->ok( 1, "We're on 1" );
+        $indented->$plan('no_plan');
+        $indented->$ok( 1, "We're on 1" );
         {
             my $indented2 = $indented->child('with name');
-            $indented2->plan( tests => 2 );
-            $indented2->ok( 1, "We're on 2.1" );
-            $indented2->ok( 1, "We're on 2.1" );
-            $indented2->finalize;
+            $indented2->$plan( tests => 2 );
+            $indented2->$ok( 1, "We're on 2.1" );
+            $indented2->$ok( 1, "We're on 2.1" );
+            $indented2->$finalize;
         }
-        $indented->ok( 1, 'after child' );
-        $indented->finalize;
+        $indented->$ok( 1, 'after child' );
+        $indented->$finalize;
     }
     for(7) {
-        $tb->ok( $_, "We're on $_" );
+        $tb->$ok( $_, "We're on $_" );
     }
 
     $tb->_ending;
@@ -107,20 +113,20 @@ END
 
     {
         my $child = $tb->child('expected to fail');
-        $child->plan( tests => 3 );
-        $child->ok(1);
-        $child->ok(0);
-        $child->ok(3);
-        $child->finalize;
+        $child->$plan( tests => 3 );
+        $child->$ok(1);
+        $child->$ok(0);
+        $child->$ok(3);
+        $child->$finalize;
     }
 
     {
         my $child = $tb->child('expected to pass');
-        $child->plan( tests => 3 );
-        $child->ok(1);
-        $child->ok(2);
-        $child->ok(3);
-        $child->finalize;
+        $child->$plan( tests => 3 );
+        $child->$ok(1);
+        $child->$ok(2);
+        $child->$ok(3);
+        $child->$finalize;
     }
     is $tb->read, <<"END", 'Previous child failures should not force subsequent failures';
     1..3
@@ -144,7 +150,7 @@ END
     my $child = $tb->child('one');
     is $child->{$_}, $tb->{$_}, "The child should copy the ($_) filehandle"
         foreach qw{Out_FH Todo_FH Fail_FH};
-    $child->finalize;
+    $child->$finalize;
 }
 {
     my $tb    = Test::Builder::NoOutput->create;
@@ -153,9 +159,9 @@ END
 
     can_ok $tb, 'name';
     is $child->name, 'one', '... but child names should be whatever we set them to';
-    $child->finalize;
+    $child->$finalize;
     $child = $tb->child;
-    $child->finalize;
+    $child->$finalize;
 }
 # Skip all subtests
 {
@@ -163,7 +169,7 @@ END
 
     {
         my $child = $tb->child('skippy says he loves you');
-        eval { $child->plan( skip_all => 'cuz I said so' ) };
+        eval { $child->$plan( skip_all => 'cuz I said so' ) };
     }
     subtest 'skip all', sub {
         plan skip_all => 'subtest with skip_all';
@@ -175,13 +181,13 @@ END
 {
 #line 204
     my $tb = Test::Builder::NoOutput->create;
-    $tb->plan( tests => 1 );
+    $tb->$plan( tests => 1 );
     my $child = $tb->child;
-    $child->plan( tests => 1 );
+    $child->$plan( tests => 1 );
     $child->todo_start( 'message' );
-    $child->ok( 0 );
+    $child->$ok( 0 );
     $child->todo_end;
-    $child->finalize;
+    $child->$finalize;
     $tb->_ending;
     is $tb->read, <<"END", 'TODO tests should not make the parent test fail';
 1..1
@@ -193,9 +199,9 @@ END
 }
 {
     my $tb = Test::Builder::NoOutput->create;
-    $tb->plan( tests => 1 );
+    $tb->$plan( tests => 1 );
     my $child = $tb->child;
-    $child->finalize;
+    $child->$finalize;
     $tb->_ending;
     my $expected = <<"END";
 1..1
index b034893..c9efdac 100644 (file)
@@ -7,7 +7,7 @@ use Test::More;
 
 pass("First");
 
-my $file = "t/Legacy/subtest/for_do_t.test";
+my $file = "./t/Legacy/subtest/for_do_t.test";
 ok -e $file, "subtest test file exists";
 
 subtest $file => sub { do $file };
index 0fad76d..d8470d4 100644 (file)
@@ -14,7 +14,7 @@ my $st = $events->[-1];
 isa_ok($st, 'Test2::Event::Subtest');
 ok(my $id = $st->subtest_id, "got an id");
 for my $se (@{$st->subevents}) {
-    is($se->in_subtest, $id, "set subtest_id on child event");
+    is($se->trace->hid, $id, "set subtest_id on child event");
 }
 
 done_testing;
index aaa6cab..33a8c27 100644 (file)
@@ -1,6 +1,8 @@
 #!/usr/bin/perl -w
 use strict;
 use warnings;
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 use Test2::Util qw/CAN_FORK/;
 BEGIN {
@@ -14,6 +16,9 @@ use IO::Pipe;
 use Test::Builder;
 use Test::More;
 
+plan 'skip_all' => "This test cannot be run with the current formatter"
+    unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter');
+
 plan 'tests' => 1;
 
 subtest 'fork within subtest' => sub {
index 2c8cace..c697664 100644 (file)
@@ -78,13 +78,18 @@ warnings_like(qr/Use of uninitialized value.* at \(eval in cmp_ok\) $Filename li
 
 my $tb = Test::More->builder;
 
-my $err = '';
-$tb->failure_output(\$err);
-diag(undef);
-$tb->reset_outputs;
+SKIP: {
+    skip("Test cannot be run with this formatter", 2)
+        unless $tb->{Stack}->top->format->isa('Test::Builder::Formatter');
 
-is( $err, "# undef\n" );
-no_warnings;
+    my $err = '';
+    $tb->failure_output(\$err);
+    diag(undef);
+    $tb->reset_outputs;
+
+    is( $err, "# undef\n" );
+    no_warnings;
+}
 
 
 $tb->maybe_regex(undef);
index 2930226..97e4cf4 100644 (file)
@@ -1,4 +1,6 @@
 #!/usr/bin/perl -w
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
@@ -23,6 +25,9 @@ BEGIN {
 }
 
 use Test::More;
+unless (Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter')) {
+    plan skip_all => 'Test cannot be run using this formatter';
+}
 
 if( !$have_perlio ) {
     plan skip_all => "Don't have PerlIO";
index cb83599..3c46ee7 100644 (file)
@@ -1,4 +1,5 @@
 #!/usr/bin/perl -w
+# HARNESS-NO-PRELOAD
 
 # Make sure all the modules have the same version
 #
index 21c712b..1ddb70c 100644 (file)
@@ -1,10 +1,11 @@
 use strict;
 use warnings;
+# HARNESS-NO-PRELOAD
 
 use Test2::Tools::Tiny;
-use Test2::API qw/intercept/;
+use Test2::API qw/intercept test2_stack/;
 
-plan 4;
+plan 3;
 
 my @warnings;
 {
@@ -12,7 +13,7 @@ my @warnings;
     require Test::Builder;
 };
 
-is(@warnings, 3, "got 3 warnings");
+is(@warnings, 2, "got warnings");
 
 like(
     $warnings[0],
@@ -25,11 +26,3 @@ like(
     qr/Formatter Test::Builder::Formatter loaded too late to be used as the global formatter/,
     "Got the formatter warning"
 );
-
-like(
-    $warnings[2],
-    qr/The current formatter does not support 'no_header'/,
-    "Formatter does not support no_header",
-);
-
-
diff --git a/cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t b/cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t
new file mode 100644 (file)
index 0000000..b557230
--- /dev/null
@@ -0,0 +1,37 @@
+use strict;
+use warnings;
+
+BEGIN {
+    require Test2::API;
+    Test2::API::test2_start_preload();
+}
+
+use Test::More;
+
+my ($stdout, $stderr) = ('', '');
+{
+    local *STDOUT;
+    open(STDOUT, '>', \$stdout) or die "Could not open temp STDOUT";
+
+    local *STDERR;
+    open(STDERR, '>', \$stderr) or die "Could not open temp STDOUT";
+
+    diag("test\n", "diag\nfoo");
+    note("test\n", "note\nbar");
+}
+
+Test2::API::test2_stop_preload();
+
+is($stdout, <<EOT, "Got stdout");
+# test
+# note
+# bar
+EOT
+
+is($stderr, <<EOT, "Got stderr");
+# test
+# diag
+# foo
+EOT
+
+done_testing;
index 2d1dade..03b285f 100644 (file)
@@ -10,8 +10,8 @@ my $events = intercept {
     run_subtest('blah', $code, 'buffered');
 };
 
-ok(!$events->[0]->in_subtest, "main event is not inside a subtest");
+ok(!$events->[0]->trace->nested, "main event is not inside a subtest");
 ok($events->[0]->subtest_id, "Got subtest id");
-ok($events->[0]->subevents->[0]->in_subtest, "nested events are in the subtest");
+is($events->[0]->subevents->[0]->trace->hid, $events->[0]->subtest_id, "nested events are in the subtest");
 
 done_testing;
index cafc712..4f3f45d 100644 (file)
@@ -6,24 +6,28 @@ use Test2::Tools::Tiny;
 use Test2::API qw/run_subtest intercept/;
 
 my $events = intercept {
-       todo 'testing todo', sub {
-               run_subtest(
-                       'fails in todo',
-                       sub {
-                               ok(1, 'first passes');
-                               ok(0, 'second fails');
-                       });
-       };
+    todo 'testing todo', sub {
+        run_subtest(
+            'fails in todo',
+            sub {
+                ok(1, 'first passes');
+                ok(0, 'second fails');
+            }
+        );
+    };
 };
 
 ok($events->[1],                 'Test2::Event::Subtest', 'subtest ran');
 ok($events->[1]->effective_pass, 'Test2::Event::Subtest', 'subtest effective_pass is true');
 ok($events->[1]->todo,           'testing todo',          'subtest todo is set to expected value');
-my @oks = grep { $_->isa('Test2::Event::Ok') } @{$events->[1]->subevents};
-is(scalar @oks, 2, 'got 2 Ok events in the subtest');
-ok($oks[0]->pass,           'first event passed');
-ok($oks[0]->effective_pass, 'first event effective_pass is true');
-ok(!$oks[1]->pass,          'second event failed');
-ok($oks[1]->effective_pass, 'second event effective_pass is true');
+
+my $subevents = $events->[1]->subevents;
+
+is(scalar @$subevents, 3, 'got subevents in the subtest');
+
+ok($subevents->[0]->facets->{assert}->pass, 'first event passed');
+
+ok(!$subevents->[1]->facets->{assert}->pass, 'second event failed');
+ok(!$subevents->[1]->causes_fail,    'second event does not cause failure');
 
 done_testing;
diff --git a/cpan/Test-Simple/t/Test2/behavior/intercept.t b/cpan/Test-Simple/t/Test2/behavior/intercept.t
new file mode 100644 (file)
index 0000000..0d709c8
--- /dev/null
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+
+use Test2::Tools::Tiny;
+
+use Test2::API qw/intercept intercept_deep context run_subtest/;
+
+sub streamed {
+    my $name = shift;
+    my $code = shift;
+
+    my $ctx = context();
+    my $pass = run_subtest("Subtest: $name", $code, {buffered => 0}, @_);
+    $ctx->release;
+    return $pass;
+}
+
+sub buffered {
+    my $name = shift;
+    my $code = shift;
+
+    my $ctx = context();
+    my $pass = run_subtest($name, $code, {buffered => 1}, @_);
+    $ctx->release;
+    return $pass;
+}
+
+my $subtest = sub { ok(1, "pass") };
+
+my $buffered_shallow = intercept { buffered 'buffered shallow' => $subtest };
+my $streamed_shallow = intercept { streamed 'streamed shallow' => $subtest };
+my $buffered_deep = intercept_deep { buffered 'buffered shallow' => $subtest };
+my $streamed_deep = intercept_deep { streamed 'streamed shallow' => $subtest };
+
+is(@$buffered_shallow, 1, "Just got the subtest event");
+is(@$streamed_shallow, 2, "Got note, and subtest events");
+is(@$buffered_deep, 3, "Got ok, plan, and subtest events");
+is(@$streamed_deep, 4, "Got note, ok, plan, and subtest events");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test2/behavior/ipc_wait_timeout.t b/cpan/Test-Simple/t/Test2/behavior/ipc_wait_timeout.t
new file mode 100644 (file)
index 0000000..09c9a83
--- /dev/null
@@ -0,0 +1,73 @@
+use strict;
+use warnings;
+
+BEGIN {
+    eval { require threads; };
+}
+use Test2::Tools::Tiny;
+use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK/;
+use Test2::IPC;
+use Test2::API qw/test2_ipc_set_timeout test2_ipc_get_timeout/;
+
+is(test2_ipc_get_timeout(), 30, "got default timeout");
+test2_ipc_set_timeout(10);
+is(test2_ipc_get_timeout(), 10, "hanged the timeout");
+
+if (CAN_REALLY_FORK) {
+    note "Testing process waiting";
+    my ($ppiper, $ppipew);
+    pipe($ppiper, $ppipew) or die "Could not create pipe for fork";
+
+    my $proc = fork();
+    die "Could not fork!" unless defined $proc;
+
+    unless ($proc) {
+        local $SIG{ALRM} = sub { die "PROCESS TIMEOUT" };
+        alarm 15;
+        my $ignore = <$ppiper>;
+        exit 0;
+    }
+
+    my $exit;
+    my $warnings = warnings {
+        $exit = Test2::API::Instance::_ipc_wait(1);
+    };
+    is($exit, 255, "Exited 255");
+    like($warnings->[0], qr/Timeout waiting on child processes/, "Warned about timeout");
+    print $ppipew "end\n";
+
+    close($ppiper);
+    close($ppipew);
+}
+
+if (CAN_THREAD) {
+    note "Testing thread waiting";
+    my ($tpiper, $tpipew);
+    pipe($tpiper, $tpipew) or die "Could not create pipe for threads";
+
+    my $thread = threads->create(
+        sub {
+            local $SIG{ALRM} = sub { die "THREAD TIMEOUT" };
+            alarm 15;
+            my $ignore = <$tpiper>;
+        }
+    );
+
+    if ($thread->can('is_joinable')) {
+        my $exit;
+        my $warnings = warnings {
+            $exit = Test2::API::Instance::_ipc_wait(1);
+        };
+        is($exit, 255, "Exited 255");
+        like($warnings->[0], qr/Timeout waiting on child thread/, "Warned about timeout");
+    }
+    else {
+        note "threads.pm is too old for a thread joining timeout :-(";
+    }
+    print $tpipew "end\n";
+
+    close($tpiper);
+    close($tpipew);
+}
+
+done_testing;
index 8e01e40..2caf67d 100644 (file)
@@ -1,7 +1,8 @@
-# HARNESS-NO-PRELOAD
 use strict;
 use warnings;
 use Data::Dumper;
+# HARNESS-NO-STREAM
+# HARNESS-NO-PRELOAD
 
 ###############################################################################
 #                                                                             #
@@ -28,7 +29,7 @@ require Test2::Event::Waiting;
 require Test2::Util;
 require Test2::Util::ExternalMeta;
 require Test2::Util::HashBase;
-require Test2::Util::Trace;
+require Test2::EventFacet::Trace;
 
 require Test2::Hub;
 require Test2::Hub::Interceptor;
@@ -45,6 +46,6 @@ my @loaded = grep { $INC{$_} } qw{
 require Test2::Tools::Tiny;
 
 Test2::Tools::Tiny::ok(!@loaded, "Test2::API was not loaded")
-    || diag("Loaded: " . Dumper(\@loaded));
+    || Test2::Tools::Tiny::diag("Loaded: " . Dumper(\@loaded));
 
 Test2::Tools::Tiny::done_testing();
index 5a79ee4..3284c9d 100644 (file)
@@ -17,9 +17,9 @@ is($e->trace->line, $line, "subtest is at correct line");
 my $plan = pop @{$e->subevents};
 ok($plan->isa('Test2::Event::Plan'), "Removed plan");
 for my $se (@{$e->subevents}) {
-    is($se->trace->file, $file, "subtest event ($se->{name}) is at correct file");
-    is($se->trace->line, $line, "subtest event ($se->{name}) is at correct line");
-    ok($se->pass, "subtest event ($se->{name}) passed");
+    is($se->trace->file, $file, "subtest event is at correct file");
+    is($se->trace->line, $line, "subtest event is at correct line");
+    ok($se->facets->{assert}->pass, "subtest event passed");
 }
 
 
@@ -37,9 +37,9 @@ is($e->trace->line, $line, "subtest is at correct line");
 $plan = pop @{$e->subevents};
 ok($plan->isa('Test2::Event::Plan'), "Removed plan");
 for my $se (@{$e->subevents}) {
-    ok($se->trace->file ne $file, "subtest event ($se->{name}) is not in our file");
-    ok($se->trace->line ne $line, "subtest event ($se->{name}) is not on our line");
-    ok($se->pass, "subtest event ($se->{name}) passed");
+    ok($se->trace->file ne $file, "subtest event is not in our file");
+    ok($se->trace->line ne $line, "subtest event is not on our line");
+    ok($se->facets->{assert}->{pass}, "subtest event passed");
 }
 
 done_testing;
index 4cf10e5..9812205 100644 (file)
@@ -16,6 +16,8 @@ use Test2::API qw/test2_stack/;
 test2_stack->top;
 
 my $temp_hub = test2_stack->new_hub();
+require Test2::Formatter::TAP;
+$temp_hub->format(Test2::Formatter::TAP->new);
 
 my $ok = capture {
     ok(1);
diff --git a/cpan/Test-Simple/t/Test2/behavior/subtest_bailout.t b/cpan/Test-Simple/t/Test2/behavior/subtest_bailout.t
new file mode 100644 (file)
index 0000000..71a3aaa
--- /dev/null
@@ -0,0 +1,39 @@
+use Test2::Tools::Tiny;
+use strict;
+use warnings;
+
+use Test2::API qw/context run_subtest intercept/;
+
+sub subtest {
+    my ($name, $code) = @_;
+    my $ctx = context();
+    my $pass = run_subtest($name, $code, {buffered => 1}, @_);
+    $ctx->release;
+    return $pass;
+}
+
+sub bail {
+    my $ctx = context();
+    $ctx->bail(@_);
+    $ctx->release;
+}
+
+my $events = intercept {
+    subtest outer => sub {
+        subtest inner => sub {
+            bail("bye!");
+        };
+    };
+};
+
+ok($events->[0]->isa('Test2::Event::Subtest'), "Got a subtest event when bail-out issued in a buffered subtest");
+ok($events->[-1]->isa('Test2::Event::Bail'), "Bail-Out propogated");
+ok(!$events->[-1]->facet_data->{trace}->{buffered}, "Final Bail-Out is not buffered");
+
+ok($events->[0]->subevents->[-2]->isa('Test2::Event::Bail'), "Got bail out inside outer subtest");
+ok($events->[0]->subevents->[-2]->facet_data->{trace}->{buffered}, "Bail-Out is buffered");
+
+ok($events->[0]->subevents->[0]->subevents->[-2]->isa('Test2::Event::Bail'), "Got bail out inside inner subtest");
+ok($events->[0]->subevents->[0]->subevents->[-2]->facet_data->{trace}->{buffered}, "Bail-Out is buffered");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test2/behavior/trace_signature.t b/cpan/Test-Simple/t/Test2/behavior/trace_signature.t
new file mode 100644 (file)
index 0000000..bb3dbf9
--- /dev/null
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+
+use Test2::Tools::Tiny;
+use Test2::API qw/intercept context/;
+use Test2::Util qw/get_tid/;
+
+my $line;
+my $events = intercept {
+    $line = __LINE__ + 1;
+    ok(1, "pass");
+    sub {
+        my $ctx = context;
+        $ctx->pass;
+        $ctx->pass;
+        $ctx->release;
+    }->();
+};
+
+my $sigpass = $events->[0]->trace->signature;
+my $sigfail = $events->[1]->trace->signature;
+
+ok($sigpass ne $sigfail, "Each tool got a new signature");
+
+is($events->[$_]->trace->signature, $sigfail, "Diags share failed ok's signature") for 2 .. $#$events;
+
+like($sigpass, qr/^C\d+:$$:\Q${ \get_tid() }:${ \__FILE__ }:$line\E$/, "signature is sane");
+
+my $trace = Test2::EventFacet::Trace->new(frame => ['main', 'foo.t', 42, 'xxx']);
+is($trace->signature, undef, "No signature without a cid");
+
+is($events->[0]->related($events->[1]), 0, "event 0 is not related to event 1");
+is($events->[1]->related($events->[2]), 1, "event 1 is related to event 2");
+
+my $e = Test2::Event::Ok->new(pass => 1);
+is($e->related($events->[0]), undef, "Cannot check relation, invalid trace");
+
+$e = Test2::Event::Ok->new(pass => 1, trace => Test2::EventFacet::Trace->new(frame => ['', '', '', '']));
+is($e->related($events->[0]), undef, "Cannot check relation, incomplete trace");
+
+$e = Test2::Event::Ok->new(pass => 1, trace => Test2::EventFacet::Trace->new(frame => []));
+is($e->related($events->[0]), undef, "Cannot check relation, incomplete trace");
+
+done_testing;
index e58a5ff..bff3134 100644 (file)
@@ -12,7 +12,6 @@ use Test2::Tools::Tiny;
 #########################
 
 use Test2::API qw/test2_stack context/;
-use Test::Builder::Formatter;
 
 # The tools in Test2::Tools::Tiny have some intentional differences from the
 # Test::More versions, these behave more like Test::More which is important for
@@ -53,6 +52,9 @@ sub tm_note {
 test2_stack->top;
 
 my $temp_hub = test2_stack->new_hub();
+require Test::Builder::Formatter;
+$temp_hub->format(Test::Builder::Formatter->new);
+
 my $diag = capture {
     tm_diag(undef);
     tm_diag("");
index c0dbfc9..abb86b6 100644 (file)
@@ -91,7 +91,7 @@ my $events = bless [], 'My::Formatter';
 my $hub = Test2::Hub->new(
     formatter => $events,
 );
-my $trace = Test2::Util::Trace->new(
+my $trace = Test2::EventFacet::Trace->new(
     frame => [ 'Foo::Bar', 'foo_bar.t', 42, 'Foo::Bar::baz' ],
 );
 my $ctx = Test2::API::Context->new(
@@ -232,7 +232,7 @@ is_deeply(
     my $ctx = context(level => -1);
 
     my $one = Test2::API::Context->new(
-        trace => Test2::Util::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'blah']),
+        trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'blah']),
         hub => test2_stack()->top,
     );
     is($one->_depth, 0, "default depth");
@@ -257,7 +257,7 @@ is_deeply(
 {
     like(exception { Test2::API::Context->new() }, qr/The 'trace' attribute is required/, "need to have trace");
 
-    my $trace = Test2::Util::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'foo']);
+    my $trace = Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'foo']);
     like(exception { Test2::API::Context->new(trace => $trace) }, qr/The 'hub' attribute is required/, "need to have hub");
 
     my $hub = test2_stack()->top;
@@ -336,15 +336,10 @@ sub {
 }->();
 
 {
-    {
-        package An::Info::Thingy;
-        sub render { 'zzz' }
-    }
-
     my ($e1, $e2);
     my $events = intercept {
         my $ctx = context();
-        $e1 = $ctx->ok(0, 'foo', ['xxx', sub { 'yyy' }, bless({}, 'An::Info::Thingy')]);
+        $e1 = $ctx->ok(0, 'foo', ['xxx']);
         $e2 = $ctx->ok(0, 'foo');
         $ctx->release;
     };
@@ -353,19 +348,12 @@ sub {
     ok($e2->isa('Test2::Event::Ok'), "returned ok event");
 
     is($events->[0], $e1, "got ok event 1");
+    is($events->[3], $e2, "got ok event 2");
 
     is($events->[2]->message, 'xxx', "event 1 diag 2");
     ok($events->[2]->isa('Test2::Event::Diag'), "event 1 diag 2 is diag");
 
-    is($events->[3]->summary,     'yyy', "event 1 info 1");
-    is($events->[3]->diagnostics, 1,     "event 1 info 1 is diagnostics");
-    ok($events->[3]->isa('Test2::Event::Info'), "event 1 info 1 is an info");
-
-    is($events->[4]->summary,     'zzz', "event 1 info 2");
-    is($events->[4]->diagnostics, 1,     "event 1 info 2 is diagnostics");
-    ok($events->[4]->isa('Test2::Event::Info'), "event 2 info 1 is an info");
-
-    is($events->[5], $e2, "got ok event 2");
+    is($events->[3], $e2, "got ok event 2");
 }
 
 sub {
index 9e3e4cc..124ae6e 100644 (file)
@@ -5,6 +5,11 @@ use Test2::IPC;
 use Test2::Tools::Tiny;
 use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK USE_THREADS get_tid/;
 
+ok(1, "Just to get things initialized.");
+
+# This test relies on TAP being the default formatter for non-canon instances
+$ENV{T2_FORMATTER} = 'TAP';
+
 my $CLASS = 'Test2::API::Instance';
 
 my $one = $CLASS->new;
@@ -19,6 +24,7 @@ is_deeply(
 
         ipc_polling => undef,
         ipc_drivers => [],
+        ipc_timeout => 30,
 
         formatters => [],
 
@@ -47,6 +53,7 @@ is_deeply(
 
         ipc_polling => undef,
         ipc_drivers => [],
+        ipc_timeout => 30,
 
         formatters => [],
 
@@ -153,7 +160,7 @@ if (CAN_REALLY_FORK) {
     die "Failed to fork!" unless defined $pid;
     unless($pid) { exit 0 }
 
-    is($one->_ipc_wait, 0, "No errors");
+    is(Test2::API::Instance::_ipc_wait, 0, "No errors");
 
     $pid = fork;
     die "Failed to fork!" unless defined $pid;
@@ -161,7 +168,7 @@ if (CAN_REALLY_FORK) {
     my @warnings;
     {
         local $SIG{__WARN__} = sub { push @warnings => @_ };
-        is($one->_ipc_wait, 255, "Process exited badly");
+        is(Test2::API::Instance::_ipc_wait, 255, "Process exited badly");
     }
     like($warnings[0], qr/Process .* did not exit cleanly \(status: 255\)/, "Warn about exit");
 }
@@ -171,7 +178,7 @@ if (CAN_THREAD && $] ge '5.010') {
     $one->reset;
 
     threads->new(sub { 1 });
-    is($one->_ipc_wait, 0, "No errors");
+    is(Test2::API::Instance::_ipc_wait, 0, "No errors");
 
     if (threads->can('error')) {
         threads->new(sub {
@@ -182,7 +189,7 @@ if (CAN_THREAD && $] ge '5.010') {
         my @warnings;
         {
             local $SIG{__WARN__} = sub { push @warnings => @_ };
-            is($one->_ipc_wait, 255, "Thread exited badly");
+            is(Test2::API::Instance::_ipc_wait, 255, "Thread exited badly");
         }
         like($warnings[0], qr/Thread .* did not end cleanly: xxx/, "Warn about exit");
     }
@@ -351,7 +358,7 @@ if (CAN_REALLY_FORK) {
 
 {
     my $ctx = bless {
-        trace => Test2::Util::Trace->new(frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'xxx']),
+        trace => Test2::EventFacet::Trace->new(frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'xxx']),
         hub => Test2::Hub->new(),
     }, 'Test2::API::Context';
     $one->contexts->{1234} = $ctx;
index 467e724..8eef5fc 100644 (file)
@@ -3,38 +3,637 @@ use warnings;
 use Test2::Tools::Tiny;
 
 use Test2::Event();
+use Test2::EventFacet::Trace();
+use Test2::Event::Generic;
+use Scalar::Util qw/reftype/;
 
-{
-    package My::MockEvent;
+tests old_api => sub {
+    {
+        package My::MockEvent;
 
-    use base 'Test2::Event';
-    use Test2::Util::HashBase qw/foo bar baz/;
-}
+        use base 'Test2::Event';
+        use Test2::Util::HashBase qw/foo bar baz/;
+    }
 
-ok(My::MockEvent->can($_), "Added $_ accessor") for qw/foo bar baz/;
+    ok(My::MockEvent->can($_), "Added $_ accessor") for qw/foo bar baz/;
 
-my $one = My::MockEvent->new(trace => 'fake');
+    my $one = My::MockEvent->new(trace => 'fake');
 
-ok(!$one->causes_fail, "Events do not cause failures by default");
+    ok(!$one->causes_fail, "Events do not cause failures by default");
 
-ok(!$one->$_, "$_ is false by default") for qw/increments_count terminate global/;
+    ok(!$one->$_, "$_ is false by default") for qw/increments_count terminate global/;
 
-ok(!$one->get_meta('xxx'), "no meta-data associated for key 'xxx'");
+    ok(!$one->get_meta('xxx'), "no meta-data associated for key 'xxx'");
 
-$one->set_meta('xxx', '123');
+    $one->set_meta('xxx', '123');
 
-is($one->meta('xxx'), '123', "got meta-data");
+    is($one->meta('xxx'), '123', "got meta-data");
 
-is($one->meta('xxx', '321'), '123', "did not use default");
+    is($one->meta('xxx', '321'), '123', "did not use default");
 
-is($one->meta('yyy', '1221'), '1221', "got the default");
+    is($one->meta('yyy', '1221'), '1221', "got the default");
 
-is($one->meta('yyy'), '1221', "last call set the value to the default for future use");
+    is($one->meta('yyy'), '1221', "last call set the value to the default for future use");
 
-is($one->summary, 'My::MockEvent', "Default summary is event package");
+    is($one->summary, 'My::MockEvent', "Default summary is event package");
 
-is($one->diagnostics, 0, "Not diagnostics by default");
+    is($one->diagnostics, 0, "Not diagnostics by default");
+};
 
-ok(!$one->in_subtest, "no subtest_id by default");
+tests deprecated => sub {
+    my $e = Test2::Event->new(trace => Test2::EventFacet::Trace->new(frame => ['foo', 'foo.pl', 42], nested => 2, hid => 'maybe'));
+
+    my $warnings = warnings {
+        local $ENV{AUTHOR_TESTING} = 1;
+        is($e->nested, 2, "Got nested from the trace");
+        is($e->in_subtest, 'maybe', "got hid from trace");
+
+        $e->trace->{nested} = 0;
+
+        local $ENV{AUTHOR_TESTING} = 0;
+        is($e->nested, 0, "Not nested");
+        is($e->in_subtest, undef, "Did not get hid");
+    };
+
+    is(@$warnings, 2, "got warnings once each");
+    like($warnings->[0], qr/Use of Test2::Event->nested\(\) is deprecated/, "Warned about deprecation");
+    like($warnings->[1], qr/Use of Test2::Event->in_subtest\(\) is deprecated/, "Warned about deprecation");
+};
+
+tests facet_data => sub {
+    my $e = Test2::Event::Generic->new(
+        causes_fail      => 0,
+        increments_count => 0,
+        diagnostics      => 0,
+        no_display       => 0,
+        callback         => undef,
+        terminate        => undef,
+        global           => undef,
+        sets_plan        => undef,
+        summary          => undef,
+        facet_data       => undef,
+    );
+
+    is_deeply(
+        $e->facet_data,
+        {
+            about => {
+                package    => 'Test2::Event::Generic',
+                details    => 'Test2::Event::Generic',
+                no_display => undef
+            },
+            control => {
+                has_callback => 0,
+                terminate    => undef,
+                global       => 0
+            },
+        },
+        "Facet data has control with onyl false values, and an about"
+    );
+
+    $e->set_trace(Test2::EventFacet::Trace->new(frame => ['foo', 'foo.t', 42]));
+    is_deeply(
+        $e->facet_data,
+        {
+            about => {
+                package    => 'Test2::Event::Generic',
+                details    => 'Test2::Event::Generic',
+                no_display => undef
+            },
+            control => {
+                has_callback => 0,
+                terminate    => undef,
+                global       => 0
+            },
+            trace => {
+                frame => ['foo', 'foo.t', 42],
+                pid => $$,
+                tid => 0,
+            },
+        },
+        "Got a trace now"
+    );
+
+    $e->set_causes_fail(1);
+    is_deeply(
+        $e->facet_data,
+        {
+            about => {
+                package    => 'Test2::Event::Generic',
+                details    => 'Test2::Event::Generic',
+                no_display => undef
+            },
+            control => {
+                has_callback => 0,
+                terminate    => undef,
+                global       => 0
+            },
+            trace => {
+                frame => ['foo', 'foo.t', 42],
+                pid   => $$,
+           &n