summaryrefslogtreecommitdiff
path: root/cpan/Test-Simple
diff options
context:
space:
mode:
authorChad Granum <chad.granum@dreamhost.com>2014-10-23 12:03:23 -0700
committerJames E Keenan <jkeenan@cpan.org>2014-10-26 11:59:40 -0400
commit07308ed1589cc2f7837b5d3a1303d200a49b9338 (patch)
treed3fd48fe8ab2e8f8432c5b7a429a41d715301bff /cpan/Test-Simple
parentb17645516d4569fdfc26a2ed61c6e8704ced92cf (diff)
downloadperl-07308ed1589cc2f7837b5d3a1303d200a49b9338.tar.gz
Import Test-More 1.301001 alpha 63
Diffstat (limited to 'cpan/Test-Simple')
-rw-r--r--cpan/Test-Simple/lib/Test/Builder.pm2946
-rw-r--r--cpan/Test-Simple/lib/Test/Builder/Module.pm128
-rw-r--r--cpan/Test-Simple/lib/Test/Builder/Tester.pm237
-rw-r--r--cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm105
-rw-r--r--cpan/Test-Simple/lib/Test/FAQ.pod477
-rw-r--r--cpan/Test-Simple/lib/Test/More.pm1593
-rw-r--r--cpan/Test-Simple/lib/Test/More/DeepCheck.pm223
-rw-r--r--cpan/Test-Simple/lib/Test/More/DeepCheck/Strict.pm328
-rw-r--r--cpan/Test-Simple/lib/Test/More/DeepCheck/Tolerant.pm330
-rw-r--r--cpan/Test-Simple/lib/Test/More/Tools.pm540
-rw-r--r--cpan/Test-Simple/lib/Test/MostlyLike.pm292
-rw-r--r--cpan/Test-Simple/lib/Test/Simple.pm155
-rw-r--r--cpan/Test-Simple/lib/Test/Stream.pm1083
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Architecture.pod444
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/ArrayBase.pm374
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/ArrayBase/Meta.pm257
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Carp.pm142
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Context.pm635
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event.pm400
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Bail.pm182
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Child.pm144
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Diag.pm198
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Finish.pm127
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Note.pm169
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Ok.pm386
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Plan.pm219
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Event/Subtest.pm275
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/ExitMagic.pm259
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/ExitMagic/Context.pm131
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Exporter.pm315
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Exporter/Meta.pm183
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/IOSets.pm243
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Meta.pm202
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm188
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Tester.pm725
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Tester/Checks.pm401
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Tester/Checks/Event.pm194
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Tester/Events.pm166
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Tester/Events/Event.pm199
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Tester/Grab.pm215
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Threads.pm163
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Toolset.pm350
-rw-r--r--cpan/Test-Simple/lib/Test/Stream/Util.pm331
-rw-r--r--cpan/Test-Simple/lib/Test/Tester.pm769
-rw-r--r--cpan/Test-Simple/lib/Test/Tester/Capture.pm159
-rw-r--r--cpan/Test-Simple/lib/Test/Tutorial/WritingTests.pod198
-rw-r--r--cpan/Test-Simple/lib/Test/Tutorial/WritingTools.pod295
-rw-r--r--cpan/Test-Simple/lib/Test/use/ok.pm150
-rw-r--r--cpan/Test-Simple/lib/ok.pm142
-rw-r--r--cpan/Test-Simple/t/00test_harness_check.t26
-rw-r--r--cpan/Test-Simple/t/Behavior/MonkeyPatching_diag.t97
-rw-r--r--cpan/Test-Simple/t/Behavior/MonkeyPatching_done_testing.t61
-rw-r--r--cpan/Test-Simple/t/Behavior/MonkeyPatching_note.t97
-rw-r--r--cpan/Test-Simple/t/Behavior/MonkeyPatching_ok.t108
-rw-r--r--cpan/Test-Simple/t/Behavior/MonkeyPatching_plan.t86
-rw-r--r--cpan/Test-Simple/t/Behavior/Munge.t30
-rw-r--r--cpan/Test-Simple/t/Behavior/NotTB15.t48
-rw-r--r--cpan/Test-Simple/t/Behavior/Tester2_subtest.t69
-rw-r--r--cpan/Test-Simple/t/Behavior/cmp_ok_xor.t13
-rw-r--r--cpan/Test-Simple/t/Behavior/encoding_test.t35
-rw-r--r--cpan/Test-Simple/t/Behavior/fork_new_end.t53
-rw-r--r--cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t47
-rw-r--r--cpan/Test-Simple/t/Behavior/todo.t43
-rw-r--r--cpan/Test-Simple/t/Builder/fork_with_new_stdout.t54
-rw-r--r--cpan/Test-Simple/t/Builder/try.t42
-rw-r--r--cpan/Test-Simple/t/Legacy/BEGIN_require_ok.t (renamed from cpan/Test-Simple/t/BEGIN_require_ok.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/BEGIN_use_ok.t (renamed from cpan/Test-Simple/t/BEGIN_use_ok.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/Builder.t (renamed from cpan/Test-Simple/t/Builder/Builder.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/carp.t (renamed from cpan/Test-Simple/t/Builder/carp.t)9
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/create.t (renamed from cpan/Test-Simple/t/Builder/create.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/current_test.t (renamed from cpan/Test-Simple/t/Builder/current_test.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/current_test_without_plan.t (renamed from cpan/Test-Simple/t/Builder/current_test_without_plan.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/details.t (renamed from cpan/Test-Simple/t/Builder/details.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/done_testing.t (renamed from cpan/Test-Simple/t/Builder/done_testing.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/done_testing_double.t (renamed from cpan/Test-Simple/t/Builder/done_testing_double.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/done_testing_plan_mismatch.t (renamed from cpan/Test-Simple/t/Builder/done_testing_plan_mismatch.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/done_testing_with_no_plan.t (renamed from cpan/Test-Simple/t/Builder/done_testing_with_no_plan.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/done_testing_with_number.t (renamed from cpan/Test-Simple/t/Builder/done_testing_with_number.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/done_testing_with_plan.t (renamed from cpan/Test-Simple/t/Builder/done_testing_with_plan.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t57
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/has_plan.t (renamed from cpan/Test-Simple/t/Builder/has_plan.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/has_plan2.t (renamed from cpan/Test-Simple/t/Builder/has_plan2.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/is_fh.t (renamed from cpan/Test-Simple/t/Builder/is_fh.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/is_passing.t (renamed from cpan/Test-Simple/t/Builder/is_passing.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/maybe_regex.t (renamed from cpan/Test-Simple/t/Builder/maybe_regex.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/no_diag.t (renamed from cpan/Test-Simple/t/Builder/no_diag.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/no_ending.t (renamed from cpan/Test-Simple/t/Builder/no_ending.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/no_header.t (renamed from cpan/Test-Simple/t/Builder/no_header.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/no_plan_at_all.t (renamed from cpan/Test-Simple/t/Builder/no_plan_at_all.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/ok_obj.t (renamed from cpan/Test-Simple/t/Builder/ok_obj.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/output.t (renamed from cpan/Test-Simple/t/Builder/output.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/reset.t (renamed from cpan/Test-Simple/t/Builder/reset.t)3
-rw-r--r--cpan/Test-Simple/t/Legacy/Builder/reset_outputs.t35
-rw-r--r--cpan/Test-Simple/t/Legacy/More.t (renamed from cpan/Test-Simple/t/More.t)7
-rw-r--r--cpan/Test-Simple/t/Legacy/PerlIO.t11
-rw-r--r--cpan/Test-Simple/t/Legacy/Simple/load.t (renamed from cpan/Test-Simple/t/Simple/load.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/TestTester/auto.t32
-rw-r--r--cpan/Test-Simple/t/Legacy/TestTester/check_tests.t116
-rw-r--r--cpan/Test-Simple/t/Legacy/TestTester/depth.t39
-rw-r--r--cpan/Test-Simple/t/Legacy/TestTester/is_bug.t31
-rw-r--r--cpan/Test-Simple/t/Legacy/TestTester/run_test.t145
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_01basic.t (renamed from cpan/Test-Simple/t/Tester/tbt_01basic.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_02fhrestore.t (renamed from cpan/Test-Simple/t/Tester/tbt_02fhrestore.t)4
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_03die.t (renamed from cpan/Test-Simple/t/Tester/tbt_03die.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_04line_num.t (renamed from cpan/Test-Simple/t/Tester/tbt_04line_num.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_05faildiag.t (renamed from cpan/Test-Simple/t/Tester/tbt_05faildiag.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t (renamed from cpan/Test-Simple/t/Tester/tbt_06errormess.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t (renamed from cpan/Test-Simple/t/Tester/tbt_07args.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_08subtest.t (renamed from cpan/Test-Simple/t/Tester/tbt_08subtest.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_09do.t (renamed from cpan/Test-Simple/t/Tester/tbt_09do.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/Tester/tbt_09do_script.pl (renamed from cpan/Test-Simple/t/Tester/tbt_09do_script.pl)0
-rw-r--r--cpan/Test-Simple/t/Legacy/bad_plan.t (renamed from cpan/Test-Simple/t/bad_plan.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/bail_out.t (renamed from cpan/Test-Simple/t/bail_out.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/buffer.t (renamed from cpan/Test-Simple/t/buffer.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/c_flag.t (renamed from cpan/Test-Simple/t/c_flag.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/circular_data.t (renamed from cpan/Test-Simple/t/circular_data.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/cmp_ok.t (renamed from cpan/Test-Simple/t/cmp_ok.t)4
-rw-r--r--cpan/Test-Simple/t/Legacy/dependents.t (renamed from cpan/Test-Simple/t/dependents.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/diag.t (renamed from cpan/Test-Simple/t/diag.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/died.t (renamed from cpan/Test-Simple/t/died.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/dont_overwrite_die_handler.t (renamed from cpan/Test-Simple/t/dont_overwrite_die_handler.t)1
-rw-r--r--cpan/Test-Simple/t/Legacy/eq_set.t (renamed from cpan/Test-Simple/t/eq_set.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/exit.t (renamed from cpan/Test-Simple/t/exit.t)5
-rw-r--r--cpan/Test-Simple/t/Legacy/explain.t (renamed from cpan/Test-Simple/t/explain.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/extra.t (renamed from cpan/Test-Simple/t/extra.t)11
-rw-r--r--cpan/Test-Simple/t/Legacy/extra_one.t (renamed from cpan/Test-Simple/t/extra_one.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/fail-like.t (renamed from cpan/Test-Simple/t/fail-like.t)8
-rw-r--r--cpan/Test-Simple/t/Legacy/fail-more.t (renamed from cpan/Test-Simple/t/fail-more.t)15
-rw-r--r--cpan/Test-Simple/t/Legacy/fail.t (renamed from cpan/Test-Simple/t/fail.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/fail_one.t (renamed from cpan/Test-Simple/t/fail_one.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/filehandles.t (renamed from cpan/Test-Simple/t/filehandles.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/fork.t (renamed from cpan/Test-Simple/t/fork.t)6
-rw-r--r--cpan/Test-Simple/t/Legacy/fork_in_subtest.t40
-rw-r--r--cpan/Test-Simple/t/Legacy/harness_active.t (renamed from cpan/Test-Simple/t/harness_active.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/import.t (renamed from cpan/Test-Simple/t/import.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/is_deeply_dne_bug.t (renamed from cpan/Test-Simple/t/is_deeply_dne_bug.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/is_deeply_fail.t (renamed from cpan/Test-Simple/t/is_deeply_fail.t)4
-rw-r--r--cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t (renamed from cpan/Test-Simple/t/is_deeply_with_threads.t)17
-rw-r--r--cpan/Test-Simple/t/Legacy/missing.t (renamed from cpan/Test-Simple/t/missing.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/new_ok.t (renamed from cpan/Test-Simple/t/new_ok.t)4
-rw-r--r--cpan/Test-Simple/t/Legacy/no_plan.t (renamed from cpan/Test-Simple/t/no_plan.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/no_tests.t (renamed from cpan/Test-Simple/t/no_tests.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/note.t (renamed from cpan/Test-Simple/t/note.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/overload.t (renamed from cpan/Test-Simple/t/overload.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/overload_threads.t (renamed from cpan/Test-Simple/t/overload_threads.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/plan.t (renamed from cpan/Test-Simple/t/plan.t)4
-rw-r--r--cpan/Test-Simple/t/Legacy/plan_bad.t (renamed from cpan/Test-Simple/t/plan_bad.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/plan_is_noplan.t (renamed from cpan/Test-Simple/t/plan_is_noplan.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/plan_no_plan.t (renamed from cpan/Test-Simple/t/plan_no_plan.t)4
-rw-r--r--cpan/Test-Simple/t/Legacy/plan_shouldnt_import.t (renamed from cpan/Test-Simple/t/plan_shouldnt_import.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/plan_skip_all.t (renamed from cpan/Test-Simple/t/plan_skip_all.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/pod.t7
-rw-r--r--cpan/Test-Simple/t/Legacy/require_ok.t (renamed from cpan/Test-Simple/t/require_ok.t)9
-rw-r--r--cpan/Test-Simple/t/Legacy/ribasushi_diag.t59
-rw-r--r--cpan/Test-Simple/t/Legacy/ribasushi_threads.t77
-rw-r--r--cpan/Test-Simple/t/Legacy/ribasushi_threads2.t51
-rw-r--r--cpan/Test-Simple/t/Legacy/simple.t (renamed from cpan/Test-Simple/t/simple.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/skip.t (renamed from cpan/Test-Simple/t/skip.t)15
-rw-r--r--cpan/Test-Simple/t/Legacy/skipall.t (renamed from cpan/Test-Simple/t/skipall.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/strays.t27
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/args.t (renamed from cpan/Test-Simple/t/subtest/args.t)1
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/bail_out.t (renamed from cpan/Test-Simple/t/subtest/bail_out.t)29
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/basic.t (renamed from cpan/Test-Simple/t/subtest/basic.t)11
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/die.t (renamed from cpan/Test-Simple/t/subtest/die.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/do.t (renamed from cpan/Test-Simple/t/subtest/do.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/exceptions.t (renamed from cpan/Test-Simple/t/subtest/exceptions.t)10
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/for_do_t.test (renamed from cpan/Test-Simple/t/subtest/for_do_t.test)0
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/fork.t (renamed from cpan/Test-Simple/t/subtest/fork.t)12
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/implicit_done.t (renamed from cpan/Test-Simple/t/subtest/implicit_done.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/line_numbers.t (renamed from cpan/Test-Simple/t/subtest/line_numbers.t)21
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/plan.t (renamed from cpan/Test-Simple/t/subtest/plan.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/predicate.t (renamed from cpan/Test-Simple/t/subtest/predicate.t)12
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/singleton.t (renamed from cpan/Test-Simple/t/subtest/singleton.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/threads.t (renamed from cpan/Test-Simple/t/subtest/threads.t)4
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/todo.t (renamed from cpan/Test-Simple/t/subtest/todo.t)24
-rw-r--r--cpan/Test-Simple/t/Legacy/subtest/wstat.t (renamed from cpan/Test-Simple/t/subtest/wstat.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/tbm_doesnt_set_exported_to.t (renamed from cpan/Test-Simple/t/tbm_doesnt_set_exported_to.t)2
-rw-r--r--cpan/Test-Simple/t/Legacy/test_use_ok.t40
-rw-r--r--cpan/Test-Simple/t/Legacy/thread_taint.t (renamed from cpan/Test-Simple/t/thread_taint.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/threads.t47
-rw-r--r--cpan/Test-Simple/t/Legacy/todo.t (renamed from cpan/Test-Simple/t/todo.t)14
-rw-r--r--cpan/Test-Simple/t/Legacy/undef.t (renamed from cpan/Test-Simple/t/undef.t)13
-rw-r--r--cpan/Test-Simple/t/Legacy/use_ok.t (renamed from cpan/Test-Simple/t/use_ok.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/useing.t (renamed from cpan/Test-Simple/t/useing.t)0
-rw-r--r--cpan/Test-Simple/t/Legacy/utf8.t (renamed from cpan/Test-Simple/t/utf8.t)6
-rw-r--r--cpan/Test-Simple/t/Legacy/versions.t50
-rw-r--r--cpan/Test-Simple/t/Test-Builder.t10
-rw-r--r--cpan/Test-Simple/t/Test-More-DeepCheck.t7
-rw-r--r--cpan/Test-Simple/t/Test-More.t29
-rw-r--r--cpan/Test-Simple/t/Test-MostlyLike.t159
-rw-r--r--cpan/Test-Simple/t/Test-Simple.t24
-rw-r--r--cpan/Test-Simple/t/Test-Stream-ArrayBase-Meta.t10
-rw-r--r--cpan/Test-Simple/t/Test-Stream-ArrayBase.t97
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Carp.t53
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Event-Diag.t24
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Event-Finish.t7
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Event-Note.t19
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Event.t30
-rw-r--r--cpan/Test-Simple/t/Test-Stream-ExitMagic-Context.t8
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Exporter-Meta.t9
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Exporter.t87
-rw-r--r--cpan/Test-Simple/t/Test-Stream-IOSets.t31
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Meta.t16
-rw-r--r--cpan/Test-Simple/t/Test-Stream-PackageUtil.t38
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Tester-Grab.t11
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Tester.t140
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Toolset.t11
-rw-r--r--cpan/Test-Simple/t/Test-Stream-Util.t45
-rw-r--r--cpan/Test-Simple/t/Test-Tester-Capture.t9
-rw-r--r--cpan/Test-Simple/t/Test-Tester.t9
-rw-r--r--cpan/Test-Simple/t/Test-use-ok.t25
-rw-r--r--cpan/Test-Simple/t/lib/MyTest.pm15
-rw-r--r--cpan/Test-Simple/t/lib/SmallTest.pm35
-rw-r--r--cpan/Test-Simple/t/threads.t33
-rw-r--r--cpan/Test-Simple/t/versions.t28
-rw-r--r--cpan/Test-Simple/t/xt/dependents.t51
216 files changed, 18063 insertions, 3460 deletions
diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm
index 97c7a9e485..c307e85e27 100644
--- a/cpan/Test-Simple/lib/Test/Builder.pm
+++ b/cpan/Test-Simple/lib/Test/Builder.pm
@@ -1,1548 +1,691 @@
package Test::Builder;
-use 5.006;
+use 5.008001;
use strict;
use warnings;
-our $VERSION = '1.001008';
+our $VERSION = '1.301001_063';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-BEGIN {
- if( $] < 5.008 ) {
- require Test::Builder::IO::Scalar;
- }
-}
+use Test::More::Tools;
+
+use Test::Stream qw/ -internal STATE_LEGACY STATE_PLAN STATE_COUNT /;
+use Test::Stream::Toolset;
+use Test::Stream::Context;
+use Test::Stream::Carp qw/confess/;
+use Test::Stream::Util qw/try protect unoverload_str is_regex/;
+use Scalar::Util qw/blessed reftype/;
-# Make Test::Builder thread-safe for ithreads.
BEGIN {
- use Config;
- # Load threads::shared when threads are turned on.
- # 5.8.0's threads are so busted we no longer support them.
- if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) {
- require threads::shared;
-
- # Hack around YET ANOTHER threads::shared bug. It would
- # occasionally forget the contents of the variable when sharing it.
- # So we first copy the data, then share, then put our copy back.
- *share = sub (\[$@%]) {
- my $type = ref $_[0];
- my $data;
-
- if( $type eq 'HASH' ) {
- %$data = %{ $_[0] };
- }
- elsif( $type eq 'ARRAY' ) {
- @$data = @{ $_[0] };
- }
- elsif( $type eq 'SCALAR' ) {
- $$data = ${ $_[0] };
- }
- else {
- die( "Unknown type: " . $type );
- }
-
- $_[0] = &threads::shared::share( $_[0] );
-
- if( $type eq 'HASH' ) {
- %{ $_[0] } = %$data;
- }
- elsif( $type eq 'ARRAY' ) {
- @{ $_[0] } = @$data;
- }
- elsif( $type eq 'SCALAR' ) {
- ${ $_[0] } = $$data;
- }
- else {
- die( "Unknown type: " . $type );
- }
-
- return $_[0];
- };
- }
- # 5.8.0's threads::shared is busted when threads are off
- # and earlier Perls just don't have that module at all.
- else {
- *share = sub { return $_[0] };
- *lock = sub { 0 };
- }
+ Test::Stream->shared->set_use_legacy(1);
}
-=head1 NAME
-
-Test::Builder - Backend for building test libraries
-
-=head1 SYNOPSIS
-
- package My::Test::Module;
- use base 'Test::Builder::Module';
-
- my $CLASS = __PACKAGE__;
-
- sub ok {
- my($test, $name) = @_;
- my $tb = $CLASS->builder;
-
- $tb->ok($test, $name);
- }
+# The mostly-singleton, and other package vars.
+our $Test = Test::Builder->new;
+our $_ORIG_Test = $Test;
+our $Level = 1;
+sub ctx {
+ my $self = shift || die "No self in context";
+ my ($add) = @_;
+ my $ctx = Test::Stream::Context::context(2 + ($add || 0), $self->{stream});
+ if (defined $self->{Todo}) {
+ $ctx->set_in_todo(1);
+ $ctx->set_todo($self->{Todo});
+ $ctx->set_diag_todo(1);
+ }
+ return $ctx;
+}
-=head1 DESCRIPTION
+sub stream {
+ my $self = shift;
+ return $self->{stream} || Test::Stream->shared;
+}
-L<Test::Simple> and L<Test::More> have proven to be popular testing modules,
-but they're not always flexible enough. Test::Builder provides a
-building block upon which to write your own test libraries I<which can
-work together>.
+sub depth { $_[0]->{depth} || 0 }
-=head2 Construction
+# This is only for unit tests at this point.
+sub _ending {
+ my $self = shift;
+ my ($ctx) = @_;
+ require Test::Stream::ExitMagic;
+ $self->{stream}->set_no_ending(0);
+ Test::Stream::ExitMagic->new->do_magic($self->{stream}, $ctx);
+}
+
+my %WARNED;
+our $CTX;
+our %ORIG = (
+ ok => \&ok,
+ diag => \&diag,
+ note => \&note,
+ plan => \&plan,
+ done_testing => \&done_testing,
+);
-=over 4
+sub WARN_OF_OVERRIDE {
+ my ($sub, $ctx) = @_;
-=item B<new>
+ return unless $ctx->modern;
+ my $old = $ORIG{$sub};
+ # Use package instead of self, we want replaced subs, not subclass overrides.
+ my $new = __PACKAGE__->can($sub);
- my $Test = Test::Builder->new;
+ return if $new == $old;
-Returns a Test::Builder object representing the current state of the
-test.
+ require B;
+ my $o = B::svref_2object($new);
+ my $gv = $o->GV;
+ my $st = $o->START;
+ my $name = $gv->NAME;
+ my $pkg = $gv->STASH->NAME;
+ my $line = $st->line;
+ my $file = $st->file;
-Since you only run one test per program C<new> always returns the same
-Test::Builder object. No matter how many times you call C<new()>, you're
-getting the same object. This is called a singleton. This is done so that
-multiple modules share such global information as the test counter and
-where test output is going.
+ warn <<" EOT" unless $WARNED{"$pkg $name $file $line"}++;
-If you want a completely new Test::Builder object different from the
-singleton, use C<create>.
+*******************************************************************************
+Something monkeypatched Test::Builder::$sub()!
+The new sub is '$pkg\::$name' defined in $file around line $line.
+In the near future monkeypatching Test::Builder::ok() will no longer work
+as expected.
+*******************************************************************************
+ EOT
+}
-=cut
-our $Test = Test::Builder->new;
+####################
+# {{{ Constructors #
+####################
sub new {
- my($class) = shift;
- $Test ||= $class->create;
+ my $class = shift;
+ my %params = @_;
+ $Test ||= $class->create(shared_stream => 1);
+
return $Test;
}
-=item B<create>
-
- my $Test = Test::Builder->create;
-
-Ok, so there can be more than one Test::Builder object and this is how
-you get it. You might use this instead of C<new()> if you're testing
-a Test::Builder based module, but otherwise you probably want C<new>.
-
-B<NOTE>: the implementation is not complete. C<level>, for example, is
-still shared amongst B<all> Test::Builder objects, even ones created using
-this method. Also, the method name may change in the future.
-
-=cut
-
sub create {
- my $class = shift;
+ my $class = shift;
+ my %params = @_;
my $self = bless {}, $class;
- $self->reset;
+ $self->reset(%params);
return $self;
}
-
# Copy an object, currently a shallow.
# This does *not* bless the destination. This keeps the destructor from
# firing when we're just storing a copy of the object to restore later.
sub _copy {
- my($src, $dest) = @_;
-
+ my ($src, $dest) = @_;
%$dest = %$src;
- _share_keys($dest);
-
return;
}
+####################
+# }}} Constructors #
+####################
-=item B<child>
-
- my $child = $builder->child($name_of_child);
- $child->plan( tests => 4 );
- $child->ok(some_code());
- ...
- $child->finalize;
-
-Returns a new instance of C<Test::Builder>. Any output from this child will
-be indented four spaces more than the parent's indentation. When done, the
-C<finalize> method I<must> be called explicitly.
+#############################
+# {{{ Children and subtests #
+#############################
-Trying to create a new child with a previous child still active (i.e.,
-C<finalize> not called) will C<croak>.
-
-Trying to run a test when you have an open child will also C<croak> and cause
-the test suite to fail.
-
-=cut
+sub subtest {
+ my $self = shift;
+ my $ctx = $self->ctx();
+ return tmt->subtest(@_);
+}
sub child {
my( $self, $name ) = @_;
- if( $self->{Child_Name} ) {
- $self->croak("You already have a child named ($self->{Child_Name}) running");
- }
-
- my $parent_in_todo = $self->in_todo;
+ my $ctx = $self->ctx;
- # Clear $TODO for the child.
- my $orig_TODO = $self->find_TODO(undef, 1, undef);
+ if ($self->{child}) {
+ my $cname = $self->{child}->{Name};
+ $ctx->throw("You already have a child named ($cname) running");
+ }
- my $class = ref $self;
- my $child = $class->create;
+ $name ||= "Child of " . $self->{Name};
+ $ctx->child('push', $name, 1);
- # Add to our indentation
- $child->_indent( $self->_indent . ' ' );
+ my $stream = $self->{stream} || Test::Stream->shared;
- # Make the child use the same outputs as the parent
- for my $method (qw(output failure_output todo_output)) {
- $child->$method( $self->$method );
- }
+ my $child = bless {
+ %$self,
+ '?' => $?,
+ parent => $self,
+ };
- # Ensure the child understands if they're inside a TODO
- if( $parent_in_todo ) {
- $child->failure_output( $self->todo_output );
- }
+ $? = 0;
+ $child->{Name} = $name;
+ $self->{child} = $child;
+ Scalar::Util::weaken($self->{child});
- # This will be reset in finalize. We do this here lest one child failure
- # cause all children to fail.
- $child->{Child_Error} = $?;
- $? = 0;
- $child->{Parent} = $self;
- $child->{Parent_TODO} = $orig_TODO;
- $child->{Name} = $name || "Child of " . $self->name;
- $self->{Child_Name} = $child->name;
return $child;
}
-
-=item B<subtest>
-
- $builder->subtest($name, \&subtests, @args);
-
-See documentation of C<subtest> in Test::More.
-
-C<subtest> also, and optionally, accepts arguments which will be passed to the
-subtests reference.
-
-=cut
-
-sub subtest {
+sub finalize {
my $self = shift;
- my($name, $subtests, @args) = @_;
- if ('CODE' ne ref $subtests) {
- $self->croak("subtest()'s second argument must be a code ref");
- }
+ return unless $self->{parent};
- # Turn the child into the parent so anyone who has stored a copy of
- # the Test::Builder singleton will get the child.
- my $error;
- my $child;
- my $parent = {};
- {
- # child() calls reset() which sets $Level to 1, so we localize
- # $Level first to limit the scope of the reset to the subtest.
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- # Store the guts of $self as $parent and turn $child into $self.
- $child = $self->child($name);
- _copy($self, $parent);
- _copy($child, $self);
-
- my $run_the_subtests = sub {
- # Add subtest name for clarification of starting point
- $self->note("Subtest: $name");
- $subtests->(@args);
- $self->done_testing unless $self->_plan_handled;
- 1;
- };
-
- if( !eval { $run_the_subtests->() } ) {
- $error = $@;
- }
- }
+ my $ctx = $self->ctx;
- # Restore the parent and the copied child.
- _copy($self, $child);
- _copy($parent, $self);
+ if ($self->{child}) {
+ my $cname = $self->{child}->{Name};
+ $ctx->throw("Can't call finalize() with child ($cname) active");
+ }
- # Restore the parent's $TODO
- $self->find_TODO(undef, 1, $child->{Parent_TODO});
+ $self->_ending($ctx);
+ my $passing = $ctx->stream->is_passing;
+ my $count = $ctx->stream->count;
+ my $name = $self->{Name};
+ $ctx = undef;
- # Die *after* we restore the parent.
- die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
+ my $stream = $self->{stream} || Test::Stream->shared;
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- my $finalize = $child->finalize;
+ my $parent = $self->parent;
+ $self->{parent}->{child} = undef;
+ $self->{parent} = undef;
- $self->BAIL_OUT($child->{Bailed_Out_Reason}) if $child->{Bailed_Out};
+ $? = $self->{'?'};
- return $finalize;
+ $ctx = $parent->ctx;
+ $ctx->child('pop', $self->{Name});
}
-=begin _private
-
-=item B<_plan_handled>
-
- if ( $Test->_plan_handled ) { ... }
-
-Returns true if the developer has explicitly handled the plan via:
-
-=over 4
-
-=item * Explicitly setting the number of tests
-
-=item * Setting 'no_plan'
-
-=item * Set 'skip_all'.
-
-=back
-
-This is currently used in subtests when we implicitly call C<< $Test->done_testing >>
-if the developer has not set a plan.
-
-=end _private
-
-=cut
-
-sub _plan_handled {
+sub in_subtest {
my $self = shift;
- return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All};
+ my $ctx = $self->ctx;
+ return scalar @{$ctx->stream->subtests};
}
+sub parent { $_[0]->{parent} }
+sub name { $_[0]->{Name} }
-=item B<finalize>
-
- my $ok = $child->finalize;
-
-When your child is done running tests, you must call C<finalize> to clean up
-and tell the parent your pass/fail status.
-
-Calling C<finalize> on a child with open children will C<croak>.
-
-If the child falls out of scope before C<finalize> is called, a failure
-diagnostic will be issued and the child is considered to have failed.
-
-No attempt to call methods on a child after C<finalize> is called is
-guaranteed to succeed.
-
-Calling this on the root builder is a no-op.
-
-=cut
-
-sub finalize {
+sub DESTROY {
my $self = shift;
+ return unless $self->{parent};
+ return if $self->{Skip_All};
+ $self->{parent}->is_passing(0);
+ my $name = $self->{Name};
+ die "Child ($name) exited without calling finalize()";
+}
- return unless $self->parent;
- if( $self->{Child_Name} ) {
- $self->croak("Can't call finalize() with child ($self->{Child_Name}) active");
- }
-
- local $? = 0; # don't fail if $subtests happened to set $? nonzero
- $self->_ending;
+#############################
+# }}} Children and subtests #
+#############################
- # XXX This will only be necessary for TAP envelopes (we think)
- #$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
+#####################################
+# {{{ stuff for TODO status #
+#####################################
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- my $ok = 1;
- $self->parent->{Child_Name} = undef;
- unless ($self->{Bailed_Out}) {
- if ( $self->{Skip_All} ) {
- $self->parent->skip($self->{Skip_All}, $self->name);
- }
- elsif ( not @{ $self->{Test_Results} } ) {
- $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
- }
- else {
- $self->parent->ok( $self->is_passing, $self->name );
+sub find_TODO {
+ my ($self, $pack, $set, $new_value) = @_;
+
+ unless ($pack) {
+ if (my $ctx = Test::Stream::Context->peek) {
+ $pack = $ctx->package;
+ my $old = $ctx->todo;
+ $ctx->set_todo($new_value) if $set;
+ return $old;
}
- }
- $? = $self->{Child_Error};
- delete $self->{Parent};
-
- return $self->is_passing;
-}
-sub _indent {
- my $self = shift;
-
- if( @_ ) {
- $self->{Indent} = shift;
+ $pack = $self->exported_to || return;
}
- return $self->{Indent};
+ no strict 'refs'; ## no critic
+ no warnings 'once';
+ my $old_value = ${$pack . '::TODO'};
+ $set and ${$pack . '::TODO'} = $new_value;
+ return $old_value;
}
-=item B<parent>
-
- if ( my $parent = $builder->parent ) {
- ...
- }
-
-Returns the parent C<Test::Builder> instance, if any. Only used with child
-builders for nested TAP.
-
-=cut
-
-sub parent { shift->{Parent} }
-
-=item B<name>
-
- diag $builder->name;
+sub todo {
+ my ($self, $pack) = @_;
-Returns the name of the current builder. Top level builders default to C<$0>
-(the name of the executable). Child builders are named via the C<child>
-method. If no name is supplied, will be named "Child of $parent->name".
+ return $self->{Todo} if defined $self->{Todo};
-=cut
+ my $ctx = $self->ctx;
-sub name { shift->{Name} }
+ my $todo = $self->find_TODO($pack);
+ return $todo if defined $todo;
-sub DESTROY {
- my $self = shift;
- if ( $self->parent and $$ == $self->{Original_Pid} ) {
- my $name = $self->name;
- $self->diag(<<"FAIL");
-Child ($name) exited without calling finalize()
-FAIL
- $self->parent->{In_Destroy} = 1;
- $self->parent->ok(0, $name);
- }
+ return '';
}
-=item B<reset>
-
- $Test->reset;
-
-Reinitializes the Test::Builder singleton to its original state.
-Mostly useful for tests run in persistent environments where the same
-test might be run multiple times in the same process.
-
-=cut
-
-our $Level;
-
-sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
- my($self) = @_;
-
- # We leave this a global because it has to be localized and localizing
- # hash keys is just asking for pain. Also, it was documented.
- $Level = 1;
-
- $self->{Name} = $0;
- $self->is_passing(1);
- $self->{Ending} = 0;
- $self->{Have_Plan} = 0;
- $self->{No_Plan} = 0;
- $self->{Have_Output_Plan} = 0;
- $self->{Done_Testing} = 0;
-
- $self->{Original_Pid} = $$;
- $self->{Child_Name} = undef;
- $self->{Indent} ||= '';
-
- $self->{Curr_Test} = 0;
- $self->{Test_Results} = &share( [] );
-
- $self->{Exported_To} = undef;
- $self->{Expected_Tests} = 0;
-
- $self->{Skip_All} = 0;
-
- $self->{Use_Nums} = 1;
-
- $self->{No_Header} = 0;
- $self->{No_Ending} = 0;
-
- $self->{Todo} = undef;
- $self->{Todo_Stack} = [];
- $self->{Start_Todo} = 0;
- $self->{Opened_Testhandles} = 0;
-
- $self->_share_keys;
- $self->_dup_stdhandles;
+sub in_todo {
+ my $self = shift;
- return;
+ return (defined $self->{Todo} || $self->find_TODO) ? 1 : 0;
}
-
-# Shared scalar values are lost when a hash is copied, so we have
-# a separate method to restore them.
-# Shared references are retained across copies.
-sub _share_keys {
+sub todo_start {
my $self = shift;
+ my $message = @_ ? shift : '';
- share( $self->{Curr_Test} );
+ $self->{Start_Todo}++;
+ if ($self->in_todo) {
+ push @{$self->{Todo_Stack}} => $self->todo;
+ }
+ $self->{Todo} = $message;
return;
}
+sub todo_end {
+ my $self = shift;
-=back
-
-=head2 Setting up tests
-
-These methods are for setting up tests and declaring how many there
-are. You usually only want to call one of these methods.
-
-=over 4
-
-=item B<plan>
-
- $Test->plan('no_plan');
- $Test->plan( skip_all => $reason );
- $Test->plan( tests => $num_tests );
-
-A convenient way to set up your tests. Call this and Test::Builder
-will print the appropriate headers and take the appropriate actions.
+ if (!$self->{Start_Todo}) {
+ $self->ctx(-1)->throw('todo_end() called without todo_start()');
+ }
-If you call C<plan()>, don't call any of the other methods below.
+ $self->{Start_Todo}--;
-If a child calls "skip_all" in the plan, a C<Test::Builder::Exception> is
-thrown. Trap this error, call C<finalize()> and don't run any more tests on
-the child.
+ if ($self->{Start_Todo} && @{$self->{Todo_Stack}}) {
+ $self->{Todo} = pop @{$self->{Todo_Stack}};
+ }
+ else {
+ delete $self->{Todo};
+ }
- my $child = $Test->child('some child');
- eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) };
- if ( eval { $@->isa('Test::Builder::Exception') } ) {
- $child->finalize;
return;
- }
- # run your tests
+}
+
+#####################################
+# }}} Finding Testers and Providers #
+#####################################
-=cut
+################
+# {{{ Planning #
+################
-my %plan_cmds = (
- no_plan => \&no_plan,
- skip_all => \&skip_all,
- tests => \&_plan_tests,
+my %PLAN_CMDS = (
+ no_plan => 'no_plan',
+ skip_all => 'skip_all',
+ tests => '_plan_tests',
);
sub plan {
- my( $self, $cmd, $arg ) = @_;
+ my ($self, $cmd, @args) = @_;
- return unless $cmd;
-
- local $Level = $Level + 1;
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
+ WARN_OF_OVERRIDE(plan => $ctx);
- $self->croak("You tried to plan twice") if $self->{Have_Plan};
+ return unless $cmd;
- if( my $method = $plan_cmds{$cmd} ) {
- local $Level = $Level + 1;
- $self->$method($arg);
+ if (my $method = $PLAN_CMDS{$cmd}) {
+ $self->$method(@args);
}
else {
- my @args = grep { defined } ( $cmd, $arg );
- $self->croak("plan() doesn't understand @args");
+ my @in = grep { defined } ($cmd, @args);
+ $self->ctx->throw("plan() doesn't understand @in");
}
return 1;
}
+sub skip_all {
+ my ($self, $reason) = @_;
-sub _plan_tests {
- my($self, $arg) = @_;
-
- if($arg) {
- local $Level = $Level + 1;
- return $self->expected_tests($arg);
- }
- elsif( !defined $arg ) {
- $self->croak("Got an undefined number of tests");
- }
- else {
- $self->croak("You said to run 0 tests");
- }
-
- return;
-}
-
-=item B<expected_tests>
-
- my $max = $Test->expected_tests;
- $Test->expected_tests($max);
-
-Gets/sets the number of tests we expect this test to run and prints out
-the appropriate headers.
-
-=cut
-
-sub expected_tests {
- my $self = shift;
- my($max) = @_;
-
- if(@_) {
- $self->croak("Number of tests must be a positive integer. You gave it '$max'")
- unless $max =~ /^\+?\d+$/;
+ $self->{Skip_All} = 1;
- $self->{Expected_Tests} = $max;
- $self->{Have_Plan} = 1;
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
- $self->_output_plan($max) unless $self->no_header;
- }
- return $self->{Expected_Tests};
+ $ctx->_plan(0, 'SKIP', $reason);
}
-=item B<no_plan>
-
- $Test->no_plan;
-
-Declares that this test will run an indeterminate number of tests.
-
-=cut
-
sub no_plan {
- my($self, $arg) = @_;
+ my ($self, @args) = @_;
- $self->carp("no_plan takes no arguments") if $arg;
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
- $self->{No_Plan} = 1;
- $self->{Have_Plan} = 1;
+ $ctx->alert("no_plan takes no arguments") if @args;
+ $ctx->_plan(0, 'NO PLAN');
return 1;
}
-=begin private
-
-=item B<_output_plan>
-
- $tb->_output_plan($max);
- $tb->_output_plan($max, $directive);
- $tb->_output_plan($max, $directive => $reason);
-
-Handles displaying the test plan.
-
-If a C<$directive> and/or C<$reason> are given they will be output with the
-plan. So here's what skipping all tests looks like:
-
- $tb->_output_plan(0, "SKIP", "Because I said so");
-
-It sets C<< $tb->{Have_Output_Plan} >> and will croak if the plan was already
-output.
-
-=end private
-
-=cut
-
-sub _output_plan {
- my($self, $max, $directive, $reason) = @_;
-
- $self->carp("The plan was already output") if $self->{Have_Output_Plan};
-
- my $plan = "1..$max";
- $plan .= " # $directive" if defined $directive;
- $plan .= " $reason" if defined $reason;
-
- $self->_print("$plan\n");
-
- $self->{Have_Output_Plan} = 1;
-
- return;
-}
-
-
-=item B<done_testing>
-
- $Test->done_testing();
- $Test->done_testing($num_tests);
-
-Declares that you are done testing, no more tests will be run after this point.
-
-If a plan has not yet been output, it will do so.
-
-$num_tests is the number of tests you planned to run. If a numbered
-plan was already declared, and if this contradicts, a failing test
-will be run to reflect the planning mistake. If C<no_plan> was declared,
-this will override.
-
-If C<done_testing()> is called twice, the second call will issue a
-failing test.
-
-If C<$num_tests> is omitted, the number of tests run will be used, like
-no_plan.
-
-C<done_testing()> is, in effect, used when you'd want to use C<no_plan>, but
-safer. You'd use it like so:
-
- $Test->ok($a == $b);
- $Test->done_testing();
-
-Or to plan a variable number of tests:
-
- for my $test (@tests) {
- $Test->ok($test);
- }
- $Test->done_testing(scalar @tests);
-
-=cut
+sub _plan_tests {
+ my ($self, $arg) = @_;
-sub done_testing {
- my($self, $num_tests) = @_;
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
- # If done_testing() specified the number of tests, shut off no_plan.
- if( defined $num_tests ) {
- $self->{No_Plan} = 0;
- }
- else {
- $num_tests = $self->current_test;
- }
+ if ($arg) {
+ $ctx->throw("Number of tests must be a positive integer. You gave it '$arg'")
+ unless $arg =~ /^\+?\d+$/;
- if( $self->{Done_Testing} ) {
- my($file, $line) = @{$self->{Done_Testing}}[1,2];
- $self->ok(0, "done_testing() was already called at $file line $line");
- return;
+ $ctx->_plan($arg);
}
-
- $self->{Done_Testing} = [caller];
-
- if( $self->expected_tests && $num_tests != $self->expected_tests ) {
- $self->ok(0, "planned to run @{[ $self->expected_tests ]} ".
- "but done_testing() expects $num_tests");
+ elsif (!defined $arg) {
+ $ctx->throw("Got an undefined number of tests");
}
else {
- $self->{Expected_Tests} = $num_tests;
+ $ctx->throw("You said to run 0 tests");
}
- $self->_output_plan($num_tests) unless $self->{Have_Output_Plan};
-
- $self->{Have_Plan} = 1;
-
- # The wrong number of tests were run
- $self->is_passing(0) if $self->{Expected_Tests} != $self->{Curr_Test};
-
- # No tests were run
- $self->is_passing(0) if $self->{Curr_Test} == 0;
-
- return 1;
+ return;
}
+sub done_testing {
+ my ($self, $num_tests) = @_;
-=item B<has_plan>
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
+ WARN_OF_OVERRIDE(done_testing => $ctx);
- $plan = $Test->has_plan
+ my $out = $ctx->stream->done_testing($ctx, $num_tests);
+ return $out;
+}
-Find out whether a plan has been defined. C<$plan> is either C<undef> (no plan
-has been set), C<no_plan> (indeterminate # of tests) or an integer (the number
-of expected tests).
+################
+# }}} Planning #
+################
-=cut
+#############################
+# {{{ Base Event Producers #
+#############################
-sub has_plan {
+sub ok {
my $self = shift;
+ my($test, $name) = @_;
- return( $self->{Expected_Tests} ) if $self->{Expected_Tests};
- return('no_plan') if $self->{No_Plan};
- return(undef);
-}
-
-=item B<skip_all>
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
+ WARN_OF_OVERRIDE(ok => $ctx);
- $Test->skip_all;
- $Test->skip_all($reason);
-
-Skips all the tests, using the given C<$reason>. Exits immediately with 0.
+ if ($self->{child}) {
+ $self->is_passing(0);
+ $ctx->throw("Cannot run test ($name) with active children");
+ }
-=cut
+ $ctx->_unwind_ok($test, $name);
+ return $test ? 1 : 0;
+}
-sub skip_all {
+sub BAIL_OUT {
my( $self, $reason ) = @_;
-
- $self->{Skip_All} = $self->parent ? $reason : 1;
-
- $self->_output_plan(0, "SKIP", $reason) unless $self->no_header;
- if ( $self->parent ) {
- die bless {} => 'Test::Builder::Exception';
- }
- exit(0);
+ $self->ctx()->bail($reason);
}
-=item B<exported_to>
-
- my $pack = $Test->exported_to;
- $Test->exported_to($pack);
-
-Tells Test::Builder what package you exported your functions to.
-
-This method isn't terribly useful since modules which share the same
-Test::Builder object might get exported to different packages and only
-the last one will be honored.
-
-=cut
-
-sub exported_to {
- my( $self, $pack ) = @_;
+sub skip {
+ my( $self, $why ) = @_;
+ $why ||= '';
+ unoverload_str( \$why );
- if( defined $pack ) {
- $self->{Exported_To} = $pack;
- }
- return $self->{Exported_To};
+ my $ctx = $self->ctx();
+ $ctx->set_skip($why);
+ $ctx->ok(1, '');
+ $ctx->set_skip(undef);
}
-=back
-
-=head2 Running tests
-
-These actually run the tests, analogous to the functions in Test::More.
-
-They all return true if the test passed, false if the test failed.
-
-C<$name> is always optional.
-
-=over 4
-
-=item B<ok>
-
- $Test->ok($test, $name);
-
-Your basic test. Pass if C<$test> is true, fail if $test is false. Just
-like Test::Simple's C<ok()>.
-
-=cut
-
-sub ok {
- my( $self, $test, $name ) = @_;
-
- if ( $self->{Child_Name} and not $self->{In_Destroy} ) {
- $name = 'unnamed test' unless defined $name;
- $self->is_passing(0);
- $self->croak("Cannot run test ($name) with active children");
- }
- # $test might contain an object which we don't want to accidentally
- # store, so we turn it into a boolean.
- $test = $test ? 1 : 0;
-
- lock $self->{Curr_Test};
- $self->{Curr_Test}++;
-
- # In case $name is a string overloaded object, force it to stringify.
- $self->_unoverload_str( \$name );
-
- $self->diag(<<"ERR") if defined $name and $name =~ /^[\d\s]+$/;
- You named your test '$name'. You shouldn't use numbers for your test names.
- Very confusing.
-ERR
-
- # Capture the value of $TODO for the rest of this ok() call
- # so it can more easily be found by other routines.
- my $todo = $self->todo();
- my $in_todo = $self->in_todo;
- local $self->{Todo} = $todo if $in_todo;
-
- $self->_unoverload_str( \$todo );
-
- my $out;
- my $result = &share( {} );
-
- unless($test) {
- $out .= "not ";
- @$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 );
- }
- else {
- @$result{ 'ok', 'actual_ok' } = ( 1, $test );
- }
-
- $out .= "ok";
- $out .= " $self->{Curr_Test}" if $self->use_numbers;
-
- if( defined $name ) {
- $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
- $out .= " - $name";
- $result->{name} = $name;
- }
- else {
- $result->{name} = '';
- }
-
- if( $self->in_todo ) {
- $out .= " # TODO $todo";
- $result->{reason} = $todo;
- $result->{type} = 'todo';
- }
- else {
- $result->{reason} = '';
- $result->{type} = '';
- }
+sub todo_skip {
+ my( $self, $why ) = @_;
+ $why ||= '';
+ unoverload_str( \$why );
- $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result;
- $out .= "\n";
+ my $ctx = $self->ctx();
+ $ctx->set_skip($why);
+ $ctx->set_todo($why);
+ $ctx->ok(0, '');
+ $ctx->set_skip(undef);
+ $ctx->set_todo(undef);
+}
- $self->_print($out);
+sub diag {
+ my $self = shift;
+ my $msg = join '', map { defined($_) ? $_ : 'undef' } @_;
- unless($test) {
- my $msg = $self->in_todo ? "Failed (TODO)" : "Failed";
- $self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE};
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
+ WARN_OF_OVERRIDE(diag => $ctx);
- my( undef, $file, $line ) = $self->caller;
- if( defined $name ) {
- $self->diag(qq[ $msg test '$name'\n]);
- $self->diag(qq[ at $file line $line.\n]);
- }
- else {
- $self->diag(qq[ $msg test at $file line $line.\n]);
- }
- }
+ $ctx->_diag($msg);
+ return;
+}
- $self->is_passing(0) unless $test || $self->in_todo;
+sub note {
+ my $self = shift;
+ my $msg = join '', map { defined($_) ? $_ : 'undef' } @_;
- # Check that we haven't violated the plan
- $self->_check_is_passing_plan();
+ my $ctx = $CTX || Test::Stream::Context->peek || $self->ctx();
+ WARN_OF_OVERRIDE(note => $ctx);
- return $test ? 1 : 0;
+ $ctx->_note($msg);
}
+#############################
+# }}} Base Event Producers #
+#############################
+
+#######################
+# {{{ Public helpers #
+#######################
-# Check that we haven't yet violated the plan and set
-# is_passing() accordingly
-sub _check_is_passing_plan {
+sub explain {
my $self = shift;
- my $plan = $self->has_plan;
- return unless defined $plan; # no plan yet defined
- return unless $plan !~ /\D/; # no numeric plan
- $self->is_passing(0) if $plan < $self->{Curr_Test};
+ return map {
+ ref $_
+ ? do {
+ protect { require Data::Dumper };
+ my $dumper = Data::Dumper->new( [$_] );
+ $dumper->Indent(1)->Terse(1);
+ $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
+ $dumper->Dump;
+ }
+ : $_
+ } @_;
}
-
-sub _unoverload {
+sub carp {
my $self = shift;
- my $type = shift;
-
- $self->_try(sub { require overload; }, die_on_fail => 1);
-
- foreach my $thing (@_) {
- if( $self->_is_object($$thing) ) {
- if( my $string_meth = overload::Method( $$thing, $type ) ) {
- $$thing = $$thing->$string_meth();
- }
- }
- }
-
- return;
+ $self->ctx->alert(join '' => @_);
}
-sub _is_object {
- my( $self, $thing ) = @_;
-
- return $self->_try( sub { ref $thing && $thing->isa('UNIVERSAL') } ) ? 1 : 0;
+sub croak {
+ my $self = shift;
+ $self->ctx->throw(join '' => @_);
}
-sub _unoverload_str {
+sub has_plan {
my $self = shift;
- return $self->_unoverload( q[""], @_ );
+ my $plan = $self->ctx->stream->plan || return undef;
+ return 'no_plan' if $plan->directive && $plan->directive eq 'NO PLAN';
+ return $plan->max;
}
-sub _unoverload_num {
+sub reset {
my $self = shift;
+ my %params = @_;
- $self->_unoverload( '0+', @_ );
+ $self->{use_shared} = 1 if $params{shared_stream};
- for my $val (@_) {
- next unless $self->_is_dualvar($$val);
- $$val = $$val + 0;
+ if ($self->{use_shared}) {
+ Test::Stream->shared->_reset;
+ Test::Stream->shared->state->[-1]->[STATE_LEGACY] = [];
+ }
+ else {
+ $self->{stream} = Test::Stream->new();
+ $self->{stream}->set_use_legacy(1);
+ $self->{stream}->state->[-1]->[STATE_LEGACY] = [];
}
- return;
-}
-
-# This is a hack to detect a dualvar such as $!
-sub _is_dualvar {
- my( $self, $val ) = @_;
-
- # Objects are not dualvars.
- return 0 if ref $val;
-
- no warnings 'numeric';
- my $numval = $val + 0;
- return ($numval != 0 and $numval ne $val ? 1 : 0);
-}
-
-=item B<is_eq>
+ # We leave this a global because it has to be localized and localizing
+ # hash keys is just asking for pain. Also, it was documented.
+ $Level = 1;
- $Test->is_eq($got, $expected, $name);
+ $self->{Name} = $0;
-Like Test::More's C<is()>. Checks if C<$got eq $expected>. This is the
-string version.
+ $self->{Original_Pid} = $$;
+ $self->{Child_Name} = undef;
-C<undef> only ever matches another C<undef>.
+ $self->{Exported_To} = undef;
-=item B<is_num>
+ $self->{Todo} = undef;
+ $self->{Todo_Stack} = [];
+ $self->{Start_Todo} = 0;
+ $self->{Opened_Testhandles} = 0;
- $Test->is_num($got, $expected, $name);
+ return;
+}
-Like Test::More's C<is()>. Checks if C<$got == $expected>. This is the
-numeric version.
+#######################
+# }}} Public helpers #
+#######################
-C<undef> only ever matches another C<undef>.
+#################################
+# {{{ Advanced Event Producers #
+#################################
-=cut
+sub cmp_ok {
+ my( $self, $got, $type, $expect, $name ) = @_;
+ my $ctx = $self->ctx;
+ my ($ok, @diag) = tmt->cmp_check($got, $type, $expect);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
sub is_eq {
my( $self, $got, $expect, $name ) = @_;
- local $Level = $Level + 1;
-
- if( !defined $got || !defined $expect ) {
- # undef only matches undef and nothing else
- my $test = !defined $got && !defined $expect;
-
- $self->ok( $test, $name );
- $self->_is_diag( $got, 'eq', $expect ) unless $test;
- return $test;
- }
-
- return $self->cmp_ok( $got, 'eq', $expect, $name );
+ my $ctx = $self->ctx;
+ my ($ok, @diag) = tmt->is_eq($got, $expect);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
}
sub is_num {
my( $self, $got, $expect, $name ) = @_;
- local $Level = $Level + 1;
-
- if( !defined $got || !defined $expect ) {
- # undef only matches undef and nothing else
- my $test = !defined $got && !defined $expect;
-
- $self->ok( $test, $name );
- $self->_is_diag( $got, '==', $expect ) unless $test;
- return $test;
- }
-
- return $self->cmp_ok( $got, '==', $expect, $name );
-}
-
-sub _diag_fmt {
- my( $self, $type, $val ) = @_;
-
- if( defined $$val ) {
- if( $type eq 'eq' or $type eq 'ne' ) {
- # quote and force string context
- $$val = "'$$val'";
- }
- else {
- # force numeric context
- $self->_unoverload_num($val);
- }
- }
- else {
- $$val = 'undef';
- }
-
- return;
-}
-
-sub _is_diag {
- my( $self, $got, $type, $expect ) = @_;
-
- $self->_diag_fmt( $type, $_ ) for \$got, \$expect;
-
- local $Level = $Level + 1;
- return $self->diag(<<"DIAGNOSTIC");
- got: $got
- expected: $expect
-DIAGNOSTIC
-
-}
-
-sub _isnt_diag {
- my( $self, $got, $type ) = @_;
-
- $self->_diag_fmt( $type, \$got );
-
- local $Level = $Level + 1;
- return $self->diag(<<"DIAGNOSTIC");
- got: $got
- expected: anything else
-DIAGNOSTIC
+ my $ctx = $self->ctx;
+ my ($ok, @diag) = tmt->is_num($got, $expect);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
}
-=item B<isnt_eq>
-
- $Test->isnt_eq($got, $dont_expect, $name);
-
-Like L<Test::More>'s C<isnt()>. Checks if C<$got ne $dont_expect>. This is
-the string version.
-
-=item B<isnt_num>
-
- $Test->isnt_num($got, $dont_expect, $name);
-
-Like L<Test::More>'s C<isnt()>. Checks if C<$got ne $dont_expect>. This is
-the numeric version.
-
-=cut
-
sub isnt_eq {
my( $self, $got, $dont_expect, $name ) = @_;
- local $Level = $Level + 1;
-
- if( !defined $got || !defined $dont_expect ) {
- # undef only matches undef and nothing else
- my $test = defined $got || defined $dont_expect;
-
- $self->ok( $test, $name );
- $self->_isnt_diag( $got, 'ne' ) unless $test;
- return $test;
- }
-
- return $self->cmp_ok( $got, 'ne', $dont_expect, $name );
+ my $ctx = $self->ctx;
+ my ($ok, @diag) = tmt->isnt_eq($got, $dont_expect);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
}
sub isnt_num {
my( $self, $got, $dont_expect, $name ) = @_;
- local $Level = $Level + 1;
-
- if( !defined $got || !defined $dont_expect ) {
- # undef only matches undef and nothing else
- my $test = defined $got || defined $dont_expect;
-
- $self->ok( $test, $name );
- $self->_isnt_diag( $got, '!=' ) unless $test;
- return $test;
- }
-
- return $self->cmp_ok( $got, '!=', $dont_expect, $name );
+ my $ctx = $self->ctx;
+ my ($ok, @diag) = tmt->isnt_num($got, $dont_expect);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
}
-=item B<like>
-
- $Test->like($thing, qr/$regex/, $name);
- $Test->like($thing, '/$regex/', $name);
-
-Like L<Test::More>'s C<like()>. Checks if $thing matches the given C<$regex>.
-
-=item B<unlike>
-
- $Test->unlike($thing, qr/$regex/, $name);
- $Test->unlike($thing, '/$regex/', $name);
-
-Like L<Test::More>'s C<unlike()>. Checks if $thing B<does not match> the
-given C<$regex>.
-
-=cut
-
sub like {
my( $self, $thing, $regex, $name ) = @_;
-
- local $Level = $Level + 1;
- return $self->_regex_ok( $thing, $regex, '=~', $name );
+ my $ctx = $self->ctx;
+ my ($ok, @diag) = tmt->regex_check($thing, $regex, '=~');
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
}
sub unlike {
my( $self, $thing, $regex, $name ) = @_;
-
- local $Level = $Level + 1;
- return $self->_regex_ok( $thing, $regex, '!~', $name );
+ my $ctx = $self->ctx;
+ my ($ok, @diag) = tmt->regex_check($thing, $regex, '!~');
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
}
-=item B<cmp_ok>
+#################################
+# }}} Advanced Event Producers #
+#################################
- $Test->cmp_ok($thing, $type, $that, $name);
+################################################
+# {{{ Misc #
+################################################
-Works just like L<Test::More>'s C<cmp_ok()>.
-
- $Test->cmp_ok($big_num, '!=', $other_big_num);
-
-=cut
-
-my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
-
-# Bad, these are not comparison operators. Should we include more?
-my %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "...");
-
-sub cmp_ok {
- my( $self, $got, $type, $expect, $name ) = @_;
-
- if ($cmp_ok_bl{$type}) {
- $self->croak("$type is not a valid comparison operator in cmp_ok()");
- }
-
- my $test;
- my $error;
- {
- ## no critic (BuiltinFunctions::ProhibitStringyEval)
-
- local( $@, $!, $SIG{__DIE__} ); # isolate eval
+sub _new_fh {
+ my $self = shift;
+ my($file_or_fh) = shift;
- my($pack, $file, $line) = $self->caller();
+ return $file_or_fh if $self->is_fh($file_or_fh);
- # This is so that warnings come out at the caller's level
- $test = eval qq[
-#line $line "(eval in cmp_ok) $file"
-\$got $type \$expect;
-];
- $error = $@;
+ my $fh;
+ if( ref $file_or_fh eq 'SCALAR' ) {
+ open $fh, ">>", $file_or_fh
+ or croak("Can't open scalar ref $file_or_fh: $!");
}
- local $Level = $Level + 1;
- my $ok = $self->ok( $test, $name );
-
- # Treat overloaded objects as numbers if we're asked to do a
- # numeric comparison.
- my $unoverload
- = $numeric_cmps{$type}
- ? '_unoverload_num'
- : '_unoverload_str';
-
- $self->diag(<<"END") if $error;
-An error occurred while using $type:
-------------------------------------
-$error
-------------------------------------
-END
-
- unless($ok) {
- $self->$unoverload( \$got, \$expect );
-
- if( $type =~ /^(eq|==)$/ ) {
- $self->_is_diag( $got, $type, $expect );
- }
- elsif( $type =~ /^(ne|!=)$/ ) {
- $self->_isnt_diag( $got, $type );
- }
- else {
- $self->_cmp_diag( $got, $type, $expect );
- }
+ else {
+ open $fh, ">", $file_or_fh
+ or croak("Can't open test output log $file_or_fh: $!");
+ Test::Stream::IOSets->_autoflush($fh);
}
- return $ok;
-}
-
-sub _cmp_diag {
- my( $self, $got, $type, $expect ) = @_;
- $got = defined $got ? "'$got'" : 'undef';
- $expect = defined $expect ? "'$expect'" : 'undef';
-
- local $Level = $Level + 1;
- return $self->diag(<<"DIAGNOSTIC");
- $got
- $type
- $expect
-DIAGNOSTIC
+ return $fh;
}
-sub _caller_context {
+sub output {
my $self = shift;
-
- my( $pack, $file, $line ) = $self->caller(1);
-
- my $code = '';
- $code .= "#line $line $file\n" if defined $file and defined $line;
-
- return $code;
+ my $handles = $self->ctx->stream->io_sets->init_encoding('legacy');
+ $handles->[0] = $self->_new_fh(@_) if @_;
+ return $handles->[0];
}
-=back
-
-
-=head2 Other Testing Methods
-
-These are methods which are used in the course of writing a test but are not themselves tests.
-
-=over 4
-
-=item B<BAIL_OUT>
-
- $Test->BAIL_OUT($reason);
-
-Indicates to the L<Test::Harness> that things are going so badly all
-testing should terminate. This includes running any additional test
-scripts.
-
-It will exit with 255.
-
-=cut
-
-sub BAIL_OUT {
- my( $self, $reason ) = @_;
-
- $self->{Bailed_Out} = 1;
-
- if ($self->parent) {
- $self->{Bailed_Out_Reason} = $reason;
- $self->no_ending(1);
- die bless {} => 'Test::Builder::Exception';
- }
-
- $self->_print("Bail out! $reason");
- exit 255;
+sub failure_output {
+ my $self = shift;
+ my $handles = $self->ctx->stream->io_sets->init_encoding('legacy');
+ $handles->[1] = $self->_new_fh(@_) if @_;
+ return $handles->[1];
}
-=for deprecated
-BAIL_OUT() used to be BAILOUT()
-
-=cut
-
-{
- no warnings 'once';
- *BAILOUT = \&BAIL_OUT;
+sub todo_output {
+ my $self = shift;
+ my $handles = $self->ctx->stream->io_sets->init_encoding('legacy');
+ $handles->[2] = $self->_new_fh(@_) if @_;
+ return $handles->[2] || $handles->[0];
}
-=item B<skip>
-
- $Test->skip;
- $Test->skip($why);
-
-Skips the current test, reporting C<$why>.
-
-=cut
-
-sub skip {
- my( $self, $why, $name ) = @_;
- $why ||= '';
- $name = '' unless defined $name;
- $self->_unoverload_str( \$why );
-
- lock( $self->{Curr_Test} );
- $self->{Curr_Test}++;
-
- $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
- {
- 'ok' => 1,
- actual_ok => 1,
- name => $name,
- type => 'skip',
- reason => $why,
- }
- );
-
- my $out = "ok";
- $out .= " $self->{Curr_Test}" if $self->use_numbers;
- $out .= " # skip";
- $out .= " $why" if length $why;
- $out .= "\n";
-
- $self->_print($out);
-
- return 1;
+sub reset_outputs {
+ my $self = shift;
+ my $ctx = $self->ctx;
+ $ctx->stream->io_sets->reset_legacy;
}
-=item B<todo_skip>
-
- $Test->todo_skip;
- $Test->todo_skip($why);
-
-Like C<skip()>, only it will declare the test as failing and TODO. Similar
-to
-
- print "not ok $tnum # TODO $why\n";
-
-=cut
-
-sub todo_skip {
- my( $self, $why ) = @_;
- $why ||= '';
-
- lock( $self->{Curr_Test} );
- $self->{Curr_Test}++;
-
- $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
- {
- 'ok' => 1,
- actual_ok => 0,
- name => '',
- type => 'todo_skip',
- reason => $why,
- }
- );
-
- my $out = "not ok";
- $out .= " $self->{Curr_Test}" if $self->use_numbers;
- $out .= " # TODO & SKIP $why\n";
-
- $self->_print($out);
-
- return 1;
+sub use_numbers {
+ my $self = shift;
+ my $ctx = $self->ctx;
+ $ctx->stream->set_use_numbers(@_) if @_;
+ $ctx->stream->use_numbers;
}
-=begin _unimplemented
-
-=item B<skip_rest>
-
- $Test->skip_rest;
- $Test->skip_rest($reason);
-
-Like C<skip()>, only it skips all the rest of the tests you plan to run
-and terminates the test.
-
-If you're running under C<no_plan>, it skips once and terminates the
-test.
-
-=end _unimplemented
-
-=back
-
-
-=head2 Test building utility methods
-
-These methods are useful when writing your own test methods.
-
-=over 4
-
-=item B<maybe_regex>
-
- $Test->maybe_regex(qr/$regex/);
- $Test->maybe_regex('/$regex/');
-
-This method used to be useful back when Test::Builder worked on Perls
-before 5.6 which didn't have qr//. Now its pretty useless.
-
-Convenience method for building testing functions that take regular
-expressions as arguments.
-
-Takes a quoted regular expression produced by C<qr//>, or a string
-representing a regular expression.
-
-Returns a Perl value which may be used instead of the corresponding
-regular expression, or C<undef> if its argument is not recognised.
-
-For example, a version of C<like()>, sans the useful diagnostic messages,
-could be written as:
-
- sub laconic_like {
- my ($self, $thing, $regex, $name) = @_;
- my $usable_regex = $self->maybe_regex($regex);
- die "expecting regex, found '$regex'\n"
- unless $usable_regex;
- $self->ok($thing =~ m/$usable_regex/, $name);
- }
-
-=cut
-
-sub maybe_regex {
- my( $self, $regex ) = @_;
- my $usable_regex = undef;
-
- return $usable_regex unless defined $regex;
-
- my( $re, $opts );
-
- # Check for qr/foo/
- if( _is_qr($regex) ) {
- $usable_regex = $regex;
- }
- # Check for '/foo/' or 'm,foo,'
- elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
- ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
- )
- {
- $usable_regex = length $opts ? "(?$opts)$re" : $re;
- }
-
- return $usable_regex;
+sub no_ending {
+ my $self = shift;
+ my $ctx = $self->ctx;
+ $ctx->stream->set_no_ending(@_) if @_;
+ $ctx->stream->no_ending || 0;
}
-sub _is_qr {
- my $regex = shift;
-
- # is_regexp() checks for regexes in a robust manner, say if they're
- # blessed.
- return re::is_regexp($regex) if defined &re::is_regexp;
- return ref $regex eq 'Regexp';
+sub no_header {
+ my $self = shift;
+ my $ctx = $self->ctx;
+ $ctx->stream->set_no_header(@_) if @_;
+ $ctx->stream->no_header || 0;
}
-sub _regex_ok {
- my( $self, $thing, $regex, $cmp, $name ) = @_;
-
- my $ok = 0;
- my $usable_regex = $self->maybe_regex($regex);
- unless( defined $usable_regex ) {
- local $Level = $Level + 1;
- $ok = $self->ok( 0, $name );
- $self->diag(" '$regex' doesn't look much like a regex to me.");
- return $ok;
- }
-
- {
- my $test;
- my $context = $self->_caller_context;
-
- {
- ## no critic (BuiltinFunctions::ProhibitStringyEval)
-
- local( $@, $!, $SIG{__DIE__} ); # isolate eval
-
- # No point in issuing an uninit warning, they'll see it in the diagnostics
- no warnings 'uninitialized';
-
- $test = eval $context . q{$test = $thing =~ /$usable_regex/ ? 1 : 0};
- }
-
- $test = !$test if $cmp eq '!~';
-
- local $Level = $Level + 1;
- $ok = $self->ok( $test, $name );
- }
-
- unless($ok) {
- $thing = defined $thing ? "'$thing'" : 'undef';
- my $match = $cmp eq '=~' ? "doesn't match" : "matches";
-
- local $Level = $Level + 1;
- $self->diag( sprintf <<'DIAGNOSTIC', $thing, $match, $regex );
- %s
- %13s '%s'
-DIAGNOSTIC
-
- }
-
- return $ok;
+sub no_diag {
+ my $self = shift;
+ my $ctx = $self->ctx;
+ $ctx->stream->set_no_diag(@_) if @_;
+ $ctx->stream->no_diag || 0;
}
-# I'm not ready to publish this. It doesn't deal with array return
-# values from the code or context.
-
-=begin private
-
-=item B<_try>
-
- my $return_from_code = $Test->try(sub { code });
- my($return_from_code, $error) = $Test->try(sub { code });
-
-Works like eval BLOCK except it ensures it has no effect on the rest
-of the test (ie. C<$@> is not set) nor is effected by outside
-interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older
-Perls.
-
-C<$error> is what would normally be in C<$@>.
-
-It is suggested you use this in place of eval BLOCK.
-
-=cut
-
-sub _try {
- my( $self, $code, %opts ) = @_;
-
- my $error;
- my $return;
- {
- local $!; # eval can mess up $!
- local $@; # don't set $@ in the test
- local $SIG{__DIE__}; # don't trip an outside DIE handler.
- $return = eval { $code->() };
- $error = $@;
- }
-
- die $error if $error and $opts{die_on_fail};
-
- return wantarray ? ( $return, $error ) : $return;
+sub exported_to {
+ my($self, $pack) = @_;
+ $self->{Exported_To} = $pack if defined $pack;
+ return $self->{Exported_To};
}
-=end private
-
-
-=item B<is_fh>
-
- my $is_fh = $Test->is_fh($thing);
-
-Determines if the given C<$thing> can be used as a filehandle.
-
-=cut
-
sub is_fh {
my $self = shift;
my $maybe_fh = shift;
@@ -1551,1121 +694,548 @@ sub is_fh {
return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref
return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
- return eval { $maybe_fh->isa("IO::Handle") } ||
- eval { tied($maybe_fh)->can('TIEHANDLE') };
-}
-
-=back
-
-
-=head2 Test style
-
-
-=over 4
-
-=item B<level>
-
- $Test->level($how_high);
-
-How far up the call stack should C<$Test> look when reporting where the
-test failed.
-
-Defaults to 1.
-
-Setting L<$Test::Builder::Level> overrides. This is typically useful
-localized:
-
- sub my_ok {
- my $test = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- $TB->ok($test);
- }
-
-To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant.
-
-=cut
-
-sub level {
- my( $self, $level ) = @_;
-
- if( defined $level ) {
- $Level = $level;
- }
- return $Level;
-}
-
-=item B<use_numbers>
-
- $Test->use_numbers($on_or_off);
-
-Whether or not the test should output numbers. That is, this if true:
-
- ok 1
- ok 2
- ok 3
-
-or this if false
-
- ok
- ok
- ok
-
-Most useful when you can't depend on the test output order, such as
-when threads or forking is involved.
-
-Defaults to on.
-
-=cut
-
-sub use_numbers {
- my( $self, $use_nums ) = @_;
-
- if( defined $use_nums ) {
- $self->{Use_Nums} = $use_nums;
- }
- return $self->{Use_Nums};
-}
-
-=item B<no_diag>
-
- $Test->no_diag($no_diag);
-
-If set true no diagnostics will be printed. This includes calls to
-C<diag()>.
-
-=item B<no_ending>
-
- $Test->no_ending($no_ending);
-
-Normally, Test::Builder does some extra diagnostics when the test
-ends. It also changes the exit code as described below.
-
-If this is true, none of that will be done.
-
-=item B<no_header>
-
- $Test->no_header($no_header);
-
-If set to true, no "1..N" header will be printed.
-
-=cut
-
-foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
- my $method = lc $attribute;
-
- my $code = sub {
- my( $self, $no ) = @_;
-
- if( defined $no ) {
- $self->{$attribute} = $no;
- }
- return $self->{$attribute};
+ my $out;
+ protect {
+ $out = eval { $maybe_fh->isa("IO::Handle") }
+ || eval { tied($maybe_fh)->can('TIEHANDLE') };
};
- no strict 'refs'; ## no critic
- *{ __PACKAGE__ . '::' . $method } = $code;
+ return $out;
}
-=back
-
-=head2 Output
-
-Controlling where the test output goes.
-
-It's ok for your test to change where STDOUT and STDERR point to,
-Test::Builder's default output settings will not be affected.
-
-=over 4
-
-=item B<diag>
-
- $Test->diag(@msgs);
-
-Prints out the given C<@msgs>. Like C<print>, arguments are simply
-appended together.
-
-Normally, it uses the C<failure_output()> handle, but if this is for a
-TODO test, the C<todo_output()> handle is used.
-
-Output will be indented and marked with a # so as not to interfere
-with test output. A newline will be put on the end if there isn't one
-already.
-
-We encourage using this rather than calling print directly.
-
-Returns false. Why? Because C<diag()> is often used in conjunction with
-a failing test (C<ok() || diag()>) it "passes through" the failure.
-
- return ok(...) || diag(...);
+sub BAILOUT { goto &BAIL_OUT }
-=for blame transfer
-Mark Fowler <mark@twoshortplanks.com>
-
-=cut
-
-sub diag {
+sub expected_tests {
my $self = shift;
- $self->_print_comment( $self->_diag_fh, @_ );
-}
-
-=item B<note>
-
- $Test->note(@msgs);
+ my $ctx = $self->ctx;
+ $ctx->plan(@_) if @_;
-Like C<diag()>, but it prints to the C<output()> handle so it will not
-normally be seen by the user except in verbose mode.
-
-=cut
-
-sub note {
- my $self = shift;
-
- $self->_print_comment( $self->output, @_ );
+ my $plan = $ctx->stream->state->[-1]->[STATE_PLAN] || return 0;
+ return $plan->max || 0;
}
-sub _diag_fh {
+sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
my $self = shift;
- local $Level = $Level + 1;
- return $self->in_todo ? $self->todo_output : $self->failure_output;
-}
-
-sub _print_comment {
- my( $self, $fh, @msgs ) = @_;
-
- return if $self->no_diag;
- return unless @msgs;
-
- # Prevent printing headers when compiling (i.e. -c)
- return if $^C;
-
- # Smash args together like print does.
- # Convert undef to 'undef' so its readable.
- my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
+ my $ctx = $self->ctx;
- # Escape the beginning, _print will take care of the rest.
- $msg =~ s/^/# /;
-
- local $Level = $Level + 1;
- $self->_print_to_fh( $fh, $msg );
-
- return 0;
+ return wantarray ? $ctx->call : $ctx->package;
}
-=item B<explain>
-
- my @dump = $Test->explain(@msgs);
-
-Will dump the contents of any references in a human readable format.
-Handy for things like...
-
- is_deeply($have, $want) || diag explain $have;
-
-or
-
- is_deeply($have, $want) || note explain $have;
-
-=cut
-
-sub explain {
- my $self = shift;
-
- return map {
- ref $_
- ? do {
- $self->_try(sub { require Data::Dumper }, die_on_fail => 1);
-
- my $dumper = Data::Dumper->new( [$_] );
- $dumper->Indent(1)->Terse(1);
- $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
- $dumper->Dump;
- }
- : $_
- } @_;
+sub level {
+ my( $self, $level ) = @_;
+ $Level = $level if defined $level;
+ return $Level;
}
-=begin _private
-
-=item B<_print>
-
- $Test->_print(@msgs);
-
-Prints to the C<output()> filehandle.
-
-=end _private
-
-=cut
-
-sub _print {
- my $self = shift;
- return $self->_print_to_fh( $self->output, @_ );
+sub maybe_regex {
+ my ($self, $regex) = @_;
+ return is_regex($regex);
}
-sub _print_to_fh {
- my( $self, $fh, @msgs ) = @_;
-
- # Prevent printing headers when only compiling. Mostly for when
- # tests are deparsed with B::Deparse
- return if $^C;
-
- my $msg = join '', @msgs;
- my $indent = $self->_indent;
-
- local( $\, $", $, ) = ( undef, ' ', '' );
-
- # Escape each line after the first with a # so we don't
- # confuse Test::Harness.
- $msg =~ s{\n(?!\z)}{\n$indent# }sg;
-
- # Stick a newline on the end if it needs it.
- $msg .= "\n" unless $msg =~ /\n\z/;
-
- return print $fh $indent, $msg;
+sub is_passing {
+ my $self = shift;
+ my $ctx = $self->ctx;
+ $ctx->stream->is_passing(@_);
}
-=item B<output>
-
-=item B<failure_output>
-
-=item B<todo_output>
-
- my $filehandle = $Test->output;
- $Test->output($filehandle);
- $Test->output($filename);
- $Test->output(\$scalar);
-
-These methods control where Test::Builder will print its output.
-They take either an open C<$filehandle>, a C<$filename> to open and write to
-or a C<$scalar> reference to append to. It will always return a C<$filehandle>.
-
-B<output> is where normal "ok/not ok" test output goes.
-
-Defaults to STDOUT.
-
-B<failure_output> is where diagnostic output on test failures and
-C<diag()> goes. It is normally not read by Test::Harness and instead is
-displayed to the user.
-
-Defaults to STDERR.
-
-C<todo_output> is used instead of C<failure_output()> for the
-diagnostics of a failing TODO test. These will not be seen by the
-user.
-
-Defaults to STDOUT.
-
-=cut
-
-sub output {
- my( $self, $fh ) = @_;
-
- if( defined $fh ) {
- $self->{Out_FH} = $self->_new_fh($fh);
- }
- return $self->{Out_FH};
-}
+# Yeah, this is not efficient, but it is only legacy support, barely anything
+# uses it, and they really should not.
+sub current_test {
+ my $self = shift;
-sub failure_output {
- my( $self, $fh ) = @_;
+ my $ctx = $self->ctx;
+
+ if (@_) {
+ my ($num) = @_;
+ my $state = $ctx->stream->state->[-1];
+ $state->[STATE_COUNT] = $num;
+
+ my $old = $state->[STATE_LEGACY] || [];
+ my $new = [];
+
+ my $nctx = $ctx->snapshot;
+ $nctx->set_todo('incrementing test number');
+ $nctx->set_in_todo(1);
+
+ for (1 .. $num) {
+ my $i;
+ $i = shift @$old while @$old && (!$i || !$i->isa('Test::Stream::Event::Ok'));
+ $i ||= Test::Stream::Event::Ok->new(
+ $nctx,
+ [CORE::caller()],
+ 0,
+ undef,
+ undef,
+ undef,
+ 1,
+ );
+
+ push @$new => $i;
+ }
- if( defined $fh ) {
- $self->{Fail_FH} = $self->_new_fh($fh);
+ $state->[STATE_LEGACY] = $new;
}
- return $self->{Fail_FH};
-}
-sub todo_output {
- my( $self, $fh ) = @_;
-
- if( defined $fh ) {
- $self->{Todo_FH} = $self->_new_fh($fh);
- }
- return $self->{Todo_FH};
+ $ctx->stream->count;
}
-sub _new_fh {
+sub details {
my $self = shift;
- my($file_or_fh) = shift;
+ my $ctx = $self->ctx;
+ my $state = $ctx->stream->state->[-1];
+ my @out;
+ return @out unless $state->[STATE_LEGACY];
- my $fh;
- if( $self->is_fh($file_or_fh) ) {
- $fh = $file_or_fh;
- }
- elsif( ref $file_or_fh eq 'SCALAR' ) {
- # Scalar refs as filehandles was added in 5.8.
- if( $] >= 5.008 ) {
- open $fh, ">>", $file_or_fh
- or $self->croak("Can't open scalar ref $file_or_fh: $!");
- }
- # Emulate scalar ref filehandles with a tie.
- else {
- $fh = Test::Builder::IO::Scalar->new($file_or_fh)
- or $self->croak("Can't tie scalar ref $file_or_fh");
- }
+ for my $e (@{$state->[STATE_LEGACY]}) {
+ next unless $e && $e->isa('Test::Stream::Event::Ok');
+ push @out => $e->to_legacy;
}
- else {
- open $fh, ">", $file_or_fh
- or $self->croak("Can't open test output log $file_or_fh: $!");
- _autoflush($fh);
- }
-
- return $fh;
-}
-
-sub _autoflush {
- my($fh) = shift;
- my $old_fh = select $fh;
- $| = 1;
- select $old_fh;
- return;
+ return @out;
}
-my( $Testout, $Testerr );
-
-sub _dup_stdhandles {
+sub summary {
my $self = shift;
-
- $self->_open_testhandles;
-
- # Set everything to unbuffered else plain prints to STDOUT will
- # come out in the wrong order from our own prints.
- _autoflush($Testout);
- _autoflush( \*STDOUT );
- _autoflush($Testerr);
- _autoflush( \*STDERR );
-
- $self->reset_outputs;
-
- return;
+ my $ctx = $self->ctx;
+ my $state = $ctx->stream->state->[-1];
+ return @{[]} unless $state->[STATE_LEGACY];
+ return map { $_->isa('Test::Stream::Event::Ok') ? ($_->bool ? 1 : 0) : ()} @{$state->[STATE_LEGACY]};
}
-sub _open_testhandles {
- my $self = shift;
+###################################
+# }}} Misc #
+###################################
- return if $self->{Opened_Testhandles};
+####################
+# {{{ TB1.5 stuff #
+####################
- # We dup STDOUT and STDERR so people can change them in their
- # test suites while still getting normal test output.
- open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
- open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!";
+# This is just a list of method Test::Builder current does not have that Test::Builder 1.5 does.
+my %TB15_METHODS = map { $_ => 1 } qw{
+ _file_and_line _join_message _make_default _my_exit _reset_todo_state
+ _result_to_hash _results _todo_state formatter history in_test
+ no_change_exit_code post_event post_result set_formatter set_plan test_end
+ test_exit_code test_start test_state
+};
- $self->_copy_io_layers( \*STDOUT, $Testout );
- $self->_copy_io_layers( \*STDERR, $Testerr );
+our $AUTOLOAD;
- $self->{Opened_Testhandles} = 1;
+sub AUTOLOAD {
+ $AUTOLOAD =~ m/^(.*)::([^:]+)$/;
+ my ($package, $sub) = ($1, $2);
- return;
-}
+ my @caller = CORE::caller();
+ my $msg = qq{Can't locate object method "$sub" via package "$package" at $caller[1] line $caller[2].\n};
-sub _copy_io_layers {
- my( $self, $src, $dst ) = @_;
+ $msg .= <<" EOT" if $TB15_METHODS{$sub};
- $self->_try(
- sub {
- require PerlIO;
- my @src_layers = PerlIO::get_layers($src);
+ *************************************************************************
+ '$sub' is a Test::Builder 1.5 method. Test::Builder 1.5 is a dead branch.
+ You need to update your code so that it no longer treats Test::Builders
+ over a specific version number as anything special.
- _apply_layers($dst, @src_layers) if @src_layers;
- }
- );
-
- return;
-}
+ See: http://blogs.perl.org/users/chad_exodist_granum/2014/03/testmore---new-maintainer-also-stop-version-checking.html
+ *************************************************************************
+ EOT
-sub _apply_layers {
- my ($fh, @layers) = @_;
- my %seen;
- my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers;
- binmode($fh, join(":", "", "raw", @unique));
+ die $msg;
}
+####################
+# }}} TB1.5 stuff #
+####################
-=item reset_outputs
-
- $tb->reset_outputs;
-
-Resets all the output filehandles back to their defaults.
-
-=cut
-
-sub reset_outputs {
- my $self = shift;
-
- $self->output ($Testout);
- $self->failure_output($Testerr);
- $self->todo_output ($Testout);
-
- return;
-}
+1;
-=item carp
+__END__
- $tb->carp(@message);
+=pod
-Warns with C<@message> but the message will appear to come from the
-point where the original test function was called (C<< $tb->caller >>).
+=head1 NAME
-=item croak
+Test::Builder - *DEPRECATED* Module for building testing libraries.
- $tb->croak(@message);
+=head1 DESCRIPTION
-Dies with C<@message> but the message will appear to come from the
-point where the original test function was called (C<< $tb->caller >>).
+This module was previously the base module for almost any testing library. This
+module is now little more than a compatability wrapper around L<Test::Stream>.
+If you are looking to write or update a testing library you should look at
+L<Test::Stream::Toolset>.
-=cut
+=head1 PACKAGE VARS
-sub _message_at_caller {
- my $self = shift;
+=over 4
- local $Level = $Level + 1;
- my( $pack, $file, $line ) = $self->caller;
- return join( "", @_ ) . " at $file line $line.\n";
-}
+=item $Test::Builder::Test
-sub carp {
- my $self = shift;
- return warn $self->_message_at_caller(@_);
-}
+The variable that holds the Test::Builder singleton.
-sub croak {
- my $self = shift;
- return die $self->_message_at_caller(@_);
-}
+=item $Test::Builder::Level
+In the past this variable was used to track stack depth so that Test::Builder
+could report the correct line number. If you use Test::Builder this will still
+work, but in new code it is better to use the L<Test::Stream::Context> module.
=back
+=head1 METHODS
-=head2 Test Status and Info
+=head2 CONSTRUCTORS
=over 4
-=item B<current_test>
+=item Test::Builder->new
- my $curr_test = $Test->current_test;
- $Test->current_test($num);
+Returns the singleton stored in C<$Test::Builder::Test>.
-Gets/sets the current test number we're on. You usually shouldn't
-have to set this.
+=item Test::Builder->create
-If set forward, the details of the missing tests are filled in as 'unknown'.
-if set backward, the details of the intervening tests are deleted. You
-can erase history if you really want to.
+=item Test::Builder->create(use_shared => 1)
-=cut
+Returns a new instance of Test::Builder. It is important to note that this
+instance will not use the shared L<Test::Stream> object unless you pass in the
+C<< use_shared => 1 >> argument.
-sub current_test {
- my( $self, $num ) = @_;
-
- lock( $self->{Curr_Test} );
- if( defined $num ) {
- $self->{Curr_Test} = $num;
-
- # If the test counter is being pushed forward fill in the details.
- my $test_results = $self->{Test_Results};
- if( $num > @$test_results ) {
- my $start = @$test_results ? @$test_results : 0;
- for( $start .. $num - 1 ) {
- $test_results->[$_] = &share(
- {
- '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;
- }
- }
- return $self->{Curr_Test};
-}
+=back
-=item B<is_passing>
+=head2 UTIL
- my $ok = $builder->is_passing;
+=over 4
-Indicates if the test suite is currently passing.
+=item $TB->ctx
-More formally, it will be false if anything has happened which makes
-it impossible for the test suite to pass. True otherwise.
+Helper method for Test::Builder to get a L<Test::Stream::Context> object.
-For example, if no tests have run C<is_passing()> will be true because
-even though a suite with no tests is a failure you can add a passing
-test to it and start passing.
+=item $TB->depth
-Don't think about it too much.
+Get the subtest depth
-=cut
+=item $TB->find_TODO
-sub is_passing {
- my $self = shift;
+=item $TB->in_todo
- if( @_ ) {
- $self->{Is_Passing} = shift;
- }
+=item $TB->todo
- return $self->{Is_Passing};
-}
+These all check on todo state and value
+=back
-=item B<summary>
+=head2 OTHER
- my @tests = $Test->summary;
+=over 4
-A simple summary of the tests so far. True for pass, false for fail.
-This is a logical pass/fail, so todos are passes.
+=item $TB->caller
-Of course, test #1 is $tests[0], etc...
+=item $TB->carp
-=cut
+=item $TB->croak
-sub summary {
- my($self) = shift;
+These let you figure out when/where the test is defined in the test file.
- return map { $_->{'ok'} } @{ $self->{Test_Results} };
-}
+=item $TB->child
-=item B<details>
+Start a subtest (Please do not use this)
- my @tests = $Test->details;
+=item $TB->finalize
-Like C<summary()>, but with a lot more detail.
+Finish a subtest (Please do not use this)
- $tests[$test_num - 1] =
- { 'ok' => is the test considered a pass?
- actual_ok => did it literally say 'ok'?
- name => name of the test (if any)
- type => type of test (if any, see below).
- reason => reason for the above (if any)
- };
+=item $TB->explain
-'ok' is true if Test::Harness will consider the test to be a pass.
+Interface to Data::Dumper that dumps whatever you give it.
-'actual_ok' is a reflection of whether or not the test literally
-printed 'ok' or 'not ok'. This is for examining the result of 'todo'
-tests.
+=item $TB->exported_to
-'name' is the name of the test.
+This used to tell you what package used Test::Builder, it never worked well.
+The previous bad and unpredictable behavior of this has largely been preserved,
+however nothing internal uses it in any meaningful way anymore.
-'type' indicates if it was a special test. Normal tests have a type
-of ''. Type can be one of the following:
+=item $TB->is_fh
- skip see skip()
- todo see todo()
- todo_skip see todo_skip()
- unknown see below
+Check if something is a filehandle
-Sometimes the Test::Builder test counter is incremented without it
-printing any test output, for example, when C<current_test()> is changed.
-In these cases, Test::Builder doesn't know the result of the test, so
-its type is 'unknown'. These details for these tests are filled in.
-They are considered ok, but the name and actual_ok is left C<undef>.
+=item $TB->level
-For example "not ok 23 - hole count # TODO insufficient donuts" would
-result in this structure:
+Get/Set C<$Test::Builder::Level>. $Level is a package var, and most thigns
+localize it, so this method is pretty useless.
- $tests[22] = # 23 - 1, since arrays start from 0.
- { ok => 1, # logically, the test passed since its todo
- actual_ok => 0, # in absolute terms, it failed
- name => 'hole count',
- type => 'todo',
- reason => 'insufficient donuts'
- };
+=item $TB->maybe_regex
-=cut
+Check if something might be a regex.
-sub details {
- my $self = shift;
- return @{ $self->{Test_Results} };
-}
+=item $TB->reset
-=item B<todo>
+Reset the builder object to a very basic and default state. You almost
+certainly do not need this unless you are writing a tool to test testing
+libraries. Even then you probably do not want this.
- my $todo_reason = $Test->todo;
- my $todo_reason = $Test->todo($pack);
+=item $TB->todo_end
-If the current tests are considered "TODO" it will return the reason,
-if any. This reason can come from a C<$TODO> variable or the last call
-to C<todo_start()>.
+=item $TB->todo_start
-Since a TODO test does not need a reason, this function can return an
-empty string even when inside a TODO block. Use C<< $Test->in_todo >>
-to determine if you are currently inside a TODO block.
+Start/end TODO state, there are better ways to do this now.
-C<todo()> is about finding the right package to look for C<$TODO> in. It's
-pretty good at guessing the right package to look at. It first looks for
-the caller based on C<$Level + 1>, since C<todo()> is usually called inside
-a test function. As a last resort it will use C<exported_to()>.
+=back
-Sometimes there is some confusion about where C<todo()> should be looking
-for the C<$TODO> variable. If you want to be sure, tell it explicitly
-what $pack to use.
+=head2 STREAM INTERFACE
-=cut
+These simply interface into functionality of L<Test::Stream>.
-sub todo {
- my( $self, $pack ) = @_;
+=over 4
- return $self->{Todo} if defined $self->{Todo};
+=item $TB->failure_output
- local $Level = $Level + 1;
- my $todo = $self->find_TODO($pack);
- return $todo if defined $todo;
+=item $TB->output
- return '';
-}
+=item $TB->reset_outputs
-=item B<find_TODO>
+=item $TB->todo_output
- my $todo_reason = $Test->find_TODO();
- my $todo_reason = $Test->find_TODO($pack);
+These get/set the IO handle used in the 'legacy' tap encoding.
-Like C<todo()> but only returns the value of C<$TODO> ignoring
-C<todo_start()>.
+=item $TB->no_diag
-Can also be used to set C<$TODO> to a new value while returning the
-old value:
+Do not display L<Test::Stream::Event::Diag> events.
- my $old_reason = $Test->find_TODO($pack, 1, $new_reason);
+=item $TB->no_ending
-=cut
+Do not do some special magic at the end that tells you what went wrong with
+tests.
-sub find_TODO {
- my( $self, $pack, $set, $new_value ) = @_;
+=item $TB->no_header
- $pack = $pack || $self->caller(1) || $self->exported_to;
- return unless $pack;
+Do not display the plan
- no strict 'refs'; ## no critic
- my $old_value = ${ $pack . '::TODO' };
- $set and ${ $pack . '::TODO' } = $new_value;
- return $old_value;
-}
+=item $TB->use_numbers
-=item B<in_todo>
+Turn numbers in TAP on and off.
- my $in_todo = $Test->in_todo;
+=back
-Returns true if the test is currently inside a TODO block.
+=head2 HISTORY
-=cut
+=over
-sub in_todo {
- my $self = shift;
+=item $TB->details
- local $Level = $Level + 1;
- return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0;
-}
+Get all the events that occured on this object. Each event will be transformed
+into a hash that matches the legacy output of this method.
-=item B<todo_start>
+=item $TB->expected_tests
- $Test->todo_start();
- $Test->todo_start($message);
+Set/Get expected number of tests
-This method allows you declare all subsequent tests as TODO tests, up until
-the C<todo_end> method has been called.
+=item $TB->has_plan
-The C<TODO:> and C<$TODO> syntax is generally pretty good about figuring out
-whether or not we're in a TODO test. However, often we find that this is not
-possible to determine (such as when we want to use C<$TODO> but
-the tests are being executed in other packages which can't be inferred
-beforehand).
+Check if there is a plan
-Note that you can use this to nest "todo" tests
+=item $TB->summary
- $Test->todo_start('working on this');
- # lots of code
- $Test->todo_start('working on that');
- # more code
- $Test->todo_end;
- $Test->todo_end;
+List of pass/fail results.
-This is generally not recommended, but large testing systems often have weird
-internal needs.
+=back
-We've tried to make this also work with the TODO: syntax, but it's not
-guaranteed and its use is also discouraged:
+=head2 EVENT GENERATORS
- TODO: {
- local $TODO = 'We have work to do!';
- $Test->todo_start('working on this');
- # lots of code
- $Test->todo_start('working on that');
- # more code
- $Test->todo_end;
- $Test->todo_end;
- }
+See L<Test::Stream::Context>, L<Test::Stream::Toolset>, and
+L<Test::More::Tools>. Calling the methods below is not advised.
-Pick one style or another of "TODO" to be on the safe side.
+=over 4
-=cut
+=item $TB->BAILOUT
-sub todo_start {
- my $self = shift;
- my $message = @_ ? shift : '';
+=item $TB->BAIL_OUT
- $self->{Start_Todo}++;
- if( $self->in_todo ) {
- push @{ $self->{Todo_Stack} } => $self->todo;
- }
- $self->{Todo} = $message;
+=item $TB->cmp_ok
- return;
-}
+=item $TB->current_test
-=item C<todo_end>
+=item $TB->diag
- $Test->todo_end;
+=item $TB->done_testing
-Stops running tests as "TODO" tests. This method is fatal if called without a
-preceding C<todo_start> method call.
+=item $TB->is_eq
-=cut
+=item $TB->is_num
-sub todo_end {
- my $self = shift;
+=item $TB->is_passing
- if( !$self->{Start_Todo} ) {
- $self->croak('todo_end() called without todo_start()');
- }
+=item $TB->isnt_eq
- $self->{Start_Todo}--;
+=item $TB->isnt_num
- if( $self->{Start_Todo} && @{ $self->{Todo_Stack} } ) {
- $self->{Todo} = pop @{ $self->{Todo_Stack} };
- }
- else {
- delete $self->{Todo};
- }
+=item $TB->like
- return;
-}
+=item $TB->no_plan
-=item B<caller>
+=item $TB->note
- my $package = $Test->caller;
- my($pack, $file, $line) = $Test->caller;
- my($pack, $file, $line) = $Test->caller($height);
+=item $TB->ok
-Like the normal C<caller()>, except it reports according to your C<level()>.
+=item $TB->plan
-C<$height> will be added to the C<level()>.
+=item $TB->skip
-If C<caller()> winds up off the top of the stack it report the highest context.
+=item $TB->skip_all
-=cut
+=item $TB->subtest
-sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
- my( $self, $height ) = @_;
- $height ||= 0;
-
- my $level = $self->level + $height + 1;
- my @caller;
- do {
- @caller = CORE::caller( $level );
- $level--;
- } until @caller;
- return wantarray ? @caller : $caller[0];
-}
+=item $TB->todo_skip
-=back
+=item $TB->unlike
-=cut
+=back
-=begin _private
+=head2 ACCESSORS
=over 4
-=item B<_sanity_check>
-
- $self->_sanity_check();
+=item $TB->stream
-Runs a bunch of end of test sanity checks to make sure reality came
-through ok. If anything is wrong it will die with a fairly friendly
-error message.
+Get the stream used by this builder (or the shared stream).
-=cut
+=item $TB->name
-#'#
-sub _sanity_check {
- my $self = shift;
+Name of the test
- $self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' );
- $self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} },
- 'Somehow you got a different number of results than tests ran!' );
+=item $TB->parent
- return;
-}
+Parent if this is a child.
-=item B<_whoa>
+=back
- $self->_whoa($check, $description);
+=head1 MONKEYPATCHING
-A sanity check, similar to C<assert()>. If the C<$check> is true, something
-has gone horribly wrong. It will die with the given C<$description> and
-a note to contact the author.
+Many legacy testing modules monkeypatch C<ok()>, C<plan()>, and others. The
+abillity to monkeypatch these to effect all events of the specified type is now
+considered discouraged. For backwords compatability monkeypatching continues to
+work, however in the distant future it will be removed. L<Test::Stream> upon
+which Test::Builder is now built, provides hooks and API's for doing everything
+that previously required monkeypatching.
-=cut
+=encoding utf8
-sub _whoa {
- my( $self, $check, $desc ) = @_;
- if($check) {
- local $Level = $Level + 1;
- $self->croak(<<"WHOA");
-WHOA! $desc
-This should never happen! Please contact the author immediately!
-WHOA
- }
+=head1 TUTORIALS
- return;
-}
+=over 4
-=item B<_my_exit>
+=item L<Test::Tutorial>
- _my_exit($exit_num);
+The original L<Test::Tutorial>. Uses comedy to introduce you to testing from
+scratch.
-Perl seems to have some trouble with exiting inside an C<END> block.
-5.6.1 does some odd things. Instead, this function edits C<$?>
-directly. It should B<only> be called from inside an C<END> block.
-It doesn't actually exit, that's your job.
+=item L<Test::Tutorial::WritingTests>
-=cut
+The L<Test::Tutorial::WritingTests> tutorial takes a more technical approach.
+The idea behind this tutorial is to give you a technical introduction to
+testing that can easily be used as a reference. This is for people who say
+"Just tell me how to do it, and quickly!".
-sub _my_exit {
- $? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars)
+=item L<Test::Tutorial::WritingTools>
- return 1;
-}
+The L<Test::Tutorial::WritingTools> tutorial is an introduction to writing
+testing tools that play nicely with other L<Test::Stream> and L<Test::Builder>
+based tools. This is what you should look at if you want to write
+Test::MyWidget.
=back
-=end _private
-
-=cut
-
-sub _ending {
- my $self = shift;
- return if $self->no_ending;
- return if $self->{Ending}++;
-
- my $real_exit_code = $?;
+=head1 SOURCE
- # Don't bother with an ending if this is a forked copy. Only the parent
- # should do the ending.
- if( $self->{Original_Pid} != $$ ) {
- return;
- }
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
- # Ran tests but never declared a plan or hit done_testing
- if( !$self->{Have_Plan} and $self->{Curr_Test} ) {
- $self->is_passing(0);
- $self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
-
- if($real_exit_code) {
- $self->diag(<<"FAIL");
-Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
-FAIL
- $self->is_passing(0);
- _my_exit($real_exit_code) && return;
- }
+=head1 MAINTAINER
- # But if the tests ran, handle exit code.
- my $test_results = $self->{Test_Results};
- if(@$test_results) {
- my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
- if ($num_failed > 0) {
+=over 4
- my $exit_code = $num_failed <= 254 ? $num_failed : 254;
- _my_exit($exit_code) && return;
- }
- }
- _my_exit(254) && return;
- }
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
- # Exit if plan() was never called. This is so "require Test::Simple"
- # doesn't puke.
- if( !$self->{Have_Plan} ) {
- return;
- }
+=back
- # Don't do an ending if we bailed out.
- if( $self->{Bailed_Out} ) {
- $self->is_passing(0);
- return;
- }
- # Figure out if we passed or failed and print helpful messages.
- my $test_results = $self->{Test_Results};
- if(@$test_results) {
- # The plan? We have no plan.
- if( $self->{No_Plan} ) {
- $self->_output_plan($self->{Curr_Test}) unless $self->no_header;
- $self->{Expected_Tests} = $self->{Curr_Test};
- }
+=head1 AUTHORS
- # Auto-extended arrays and elements which aren't explicitly
- # filled in with a shared reference will puke under 5.8.0
- # ithreads. So we have to fill them in by hand. :(
- my $empty_result = &share( {} );
- for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) {
- $test_results->[$idx] = $empty_result
- unless defined $test_results->[$idx];
- }
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
- my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
+=over 4
- my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
- if( $num_extra != 0 ) {
- my $s = $self->{Expected_Tests} == 1 ? '' : 's';
- $self->diag(<<"FAIL");
-Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}.
-FAIL
- $self->is_passing(0);
- }
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
- if($num_failed) {
- my $num_tests = $self->{Curr_Test};
- my $s = $num_failed == 1 ? '' : 's';
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
- my $qualifier = $num_extra == 0 ? '' : ' run';
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
- $self->diag(<<"FAIL");
-Looks like you failed $num_failed test$s of $num_tests$qualifier.
-FAIL
- $self->is_passing(0);
- }
+=item 唐鳳
- if($real_exit_code) {
- $self->diag(<<"FAIL");
-Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
-FAIL
- $self->is_passing(0);
- _my_exit($real_exit_code) && return;
- }
+=back
- my $exit_code;
- if($num_failed) {
- $exit_code = $num_failed <= 254 ? $num_failed : 254;
- }
- elsif( $num_extra != 0 ) {
- $exit_code = 255;
- }
- else {
- $exit_code = 0;
- }
+=head1 COPYRIGHT
- _my_exit($exit_code) && return;
- }
- elsif( $self->{Skip_All} ) {
- _my_exit(0) && return;
- }
- elsif($real_exit_code) {
- $self->diag(<<"FAIL");
-Looks like your test exited with $real_exit_code before it could output anything.
-FAIL
- $self->is_passing(0);
- _my_exit($real_exit_code) && return;
- }
- else {
- $self->diag("No tests run!\n");
- $self->is_passing(0);
- _my_exit(255) && return;
- }
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
- $self->is_passing(0);
- $self->_whoa( 1, "We fell off the end of _ending()" );
-}
+=over 4
-END {
- $Test->_ending if defined $Test;
-}
+=item Test::Stream
-=head1 EXIT CODES
+=item Test::Stream::Tester
-If all your tests passed, Test::Builder will exit with zero (which is
-normal). If anything failed it will exit with how many failed. If
-you run less (or more) tests than you planned, the missing (or extras)
-will be considered failures. If no tests were ever run Test::Builder
-will throw a warning and exit with 255. If the test died, even after
-having successfully completed all its tests, it will still be
-considered a failure and will exit with 255.
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
-So the exit codes are...
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
- 0 all tests successful
- 255 test died or all passed but wrong # of tests run
- any other number how many failed (including missing or extras)
+See F<http://www.perl.com/perl/misc/Artistic.html>
-If you fail more than 254 tests, it will be reported as 254.
+=item Test::Simple
-=head1 THREADS
+=item Test::More
-In perl 5.8.1 and later, Test::Builder is thread-safe. The test
-number is shared amongst all threads. This means if one thread sets
-the test number using C<current_test()> they will all be effected.
+=item Test::Builder
-While versions earlier than 5.8.1 had threads they contain too many
-bugs to support.
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
-Test::Builder is only thread-aware if threads.pm is loaded I<before>
-Test::Builder.
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
-=head1 MEMORY
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
-An informative hash, accessible via C<details()>, is stored for each
-test you perform. So memory usage will scale linearly with each test
-run. Although this is not a problem for most test suites, it can
-become an issue if you do large (hundred thousands to million)
-combinatorics tests in the same run.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
-In such cases, you are advised to either split the test file into smaller
-ones, or use a reverse approach, doing "normal" (code) compares and
-triggering C<fail()> should anything go unexpected.
+See F<http://www.perl.com/perl/misc/Artistic.html>
-Future versions of Test::Builder will have a way to turn history off.
+=item Test::use::ok
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
-=head1 EXAMPLES
+This work is published from Taiwan.
-CPAN can provide the best examples. L<Test::Simple>, L<Test::More>,
-L<Test::Exception> and L<Test::Differences> all use Test::Builder.
+L<http://creativecommons.org/publicdomain/zero/1.0>
-=head1 SEE ALSO
+=item Test::Tester
-L<Test::Simple>, L<Test::More>, L<Test::Harness>
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
-=head1 AUTHORS
+Under the same license as Perl itself
-Original code by chromatic, maintained by Michael G Schwern
-E<lt>schwern@pobox.comE<gt>
+See http://www.perl.com/perl/misc/Artistic.html
-=head1 MAINTAINERS
+=item Test::Builder::Tester
-=over 4
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
-=item 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.
=back
-
-=head1 COPYRIGHT
-
-Copyright 2002-2008 by chromatic E<lt>chromatic@wgz.orgE<gt> and
- Michael G Schwern E<lt>schwern@pobox.comE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
-=cut
-
-1;
-
diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm
index e5db76acd8..32b57b00b9 100644
--- a/cpan/Test-Simple/lib/Test/Builder/Module.pm
+++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm
@@ -7,13 +7,18 @@ use Test::Builder 0.99;
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '1.001008';
+our $VERSION = '1.301001_063';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
=head1 NAME
-Test::Builder::Module - Base class for test modules
+Test::Builder::Module - *DEPRECATED* Base class for test modules
+
+=head1 DEPRECATED
+
+B<This module is deprecated> See L<Test::Stream::Toolset> for what you should
+use instead.
=head1 SYNOPSIS
@@ -29,12 +34,15 @@ Test::Builder::Module - Base class for test modules
my $tb = $CLASS->builder;
return $tb->ok(@_);
}
-
+
1;
=head1 DESCRIPTION
+B<This module is deprecated> See L<Test::Stream::Toolset> for what you should
+use instead.
+
This is a superclass for L<Test::Builder>-based modules. It provides a
handful of common functionality and a method of getting at the underlying
L<Test::Builder> object.
@@ -56,8 +64,8 @@ same basic way as L<Test::More>'s, setting the plan and controlling
exporting of functions and variables. This allows your module to set
the plan independent of L<Test::More>.
-All arguments passed to C<import()> are passed onto
-C<< Your::Module->builder->plan() >> with the exception of
+All arguments passed to C<import()> are passed onto
+C<< Your::Module->builder->plan() >> with the exception of
C<< import =>[qw(things to import)] >>.
use Your::Module import => [qw(this that)], tests => 23;
@@ -76,12 +84,14 @@ C<import_extra()>.
sub import {
my($class) = shift;
+ my $test = $class->builder;
+ my $caller = caller;
+
+ warn __PACKAGE__ . " is deprecated!\n" if $caller->can('TB_INSTANCE') && $caller->TB_INSTANCE->modern;
+
# Don't run all this when loading ourself.
return 1 if $class eq 'Test::Builder::Module';
- my $test = $class->builder;
-
- my $caller = caller;
$test->exported_to($caller);
@@ -171,3 +181,105 @@ sub builder {
}
1;
+
+__END__
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm
index 5dd8436d75..6e42c4c133 100644
--- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm
+++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm
@@ -1,17 +1,23 @@
package Test::Builder::Tester;
use strict;
-our $VERSION = "1.24";
+our $VERSION = '1.301001_063';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-use Test::Builder 0.98;
+use Test::Builder 1.301001;
use Symbol;
-use Carp;
+use Test::Stream::Carp qw/croak/;
=head1 NAME
-Test::Builder::Tester - test testsuites that have been built with
+Test::Builder::Tester - *DEPRECATED* test testsuites that have been built with
Test::Builder
+=head1 DEPRECATED
+
+B<This module is deprecated.> Please see L<Test::Stream::Tester> for a
+better alternative that does not involve dealing with TAP/string output.
+
=head1 SYNOPSIS
use Test::Builder::Tester tests => 1;
@@ -48,37 +54,55 @@ output.
# set up testing
####
-my $t = Test::Builder->new;
+#my $t = Test::Builder->new;
###
# make us an exporter
###
-use Exporter;
-our @ISA = qw(Exporter);
-
-our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
+use Test::Stream::Toolset;
+use Test::Stream::Exporter;
+default_exports qw/test_out test_err test_fail test_diag test_test line_num/;
+Test::Stream::Exporter->cleanup;
-sub import {
+sub before_import {
my $class = shift;
- my(@plan) = @_;
+ my ($importer, $list) = @_;
- my $caller = caller;
+ my $meta = init_tester($importer);
+ my $context = context(1);
+ my $other = [];
+ my $idx = 0;
- $t->exported_to($caller);
- $t->plan(@plan);
+ while ($idx <= $#{$list}) {
+ my $item = $list->[$idx++];
+ next unless $item;
- my @imports = ();
- foreach my $idx ( 0 .. $#plan ) {
- if( $plan[$idx] eq 'import' ) {
- @imports = @{ $plan[ $idx + 1 ] };
- last;
+ if (defined $item and $item eq 'no_diag') {
+ Test::Stream->shared->set_no_diag(1);
+ }
+ elsif ($item eq 'tests') {
+ $context->plan($list->[$idx++]);
+ }
+ elsif ($item eq 'skip_all') {
+ $context->plan(0, 'SKIP', $list->[$idx++]);
+ }
+ elsif ($item eq 'no_plan') {
+ $context->plan(0, 'NO PLAN');
+ }
+ elsif ($item eq 'import') {
+ push @$other => @{$list->[$idx++]};
}
}
- __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports );
+ @$list = @$other;
+
+ return;
}
+
+sub builder { Test::Builder->new }
+
###
# set up file handles
###
@@ -100,6 +124,9 @@ my $testing = 0;
my $testing_num;
my $original_is_passing;
+my $original_stream;
+my $original_state;
+
# remembering where the file handles were originally connected
my $original_output_handle;
my $original_failure_handle;
@@ -114,15 +141,18 @@ sub _start_testing {
$original_harness_env = $ENV{HARNESS_ACTIVE} || 0;
$ENV{HARNESS_ACTIVE} = 0;
+ $original_stream = builder->{stream} || Test::Stream->shared;
+ $original_state = [@{$original_stream->state->[-1]}];
+
# remember what the handles were set to
- $original_output_handle = $t->output();
- $original_failure_handle = $t->failure_output();
- $original_todo_handle = $t->todo_output();
+ $original_output_handle = builder()->output();
+ $original_failure_handle = builder()->failure_output();
+ $original_todo_handle = builder()->todo_output();
# switch out to our own handles
- $t->output($output_handle);
- $t->failure_output($error_handle);
- $t->todo_output($output_handle);
+ builder()->output($output_handle);
+ builder()->failure_output($error_handle);
+ builder()->todo_output($output_handle);
# clear the expected list
$out->reset();
@@ -130,13 +160,13 @@ sub _start_testing {
# remember that we're testing
$testing = 1;
- $testing_num = $t->current_test;
- $t->current_test(0);
- $original_is_passing = $t->is_passing;
- $t->is_passing(1);
+ $testing_num = builder()->current_test;
+ builder()->current_test(0);
+ $original_is_passing = builder()->is_passing;
+ builder()->is_passing(1);
# look, we shouldn't do the ending stuff
- $t->no_ending(1);
+ builder()->no_ending(1);
}
=head2 Functions
@@ -174,6 +204,7 @@ output filehandles)
=cut
sub test_out {
+ my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
@@ -181,6 +212,7 @@ sub test_out {
}
sub test_err {
+ my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
@@ -214,6 +246,7 @@ more simply as:
=cut
sub test_fail {
+ my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
@@ -256,12 +289,13 @@ without the newlines.
=cut
sub test_diag {
+ my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
# expect the same thing, but prepended with "# "
local $_;
- $err->expect( map { "# $_" } @_ );
+ $err->expect( map { m/\S/ ? "# $_" : "" } @_ );
}
=item test_test
@@ -304,6 +338,7 @@ will function normally and cause success/errors for L<Test::Harness>.
=cut
sub test_test {
+ my $ctx = context;
# decode the arguments as described in the pod
my $mess;
my %args;
@@ -322,21 +357,23 @@ sub test_test {
unless $testing;
# okay, reconnect the test suite back to the saved handles
- $t->output($original_output_handle);
- $t->failure_output($original_failure_handle);
- $t->todo_output($original_todo_handle);
+ builder()->output($original_output_handle);
+ builder()->failure_output($original_failure_handle);
+ builder()->todo_output($original_todo_handle);
# restore the test no, etc, back to the original point
- $t->current_test($testing_num);
+ builder()->current_test($testing_num);
$testing = 0;
- $t->is_passing($original_is_passing);
+ builder()->is_passing($original_is_passing);
# re-enable the original setting of the harness
$ENV{HARNESS_ACTIVE} = $original_harness_env;
+ $original_stream->state->[-1] = $original_state;
+
# check the output we've stashed
- unless( $t->ok( ( $args{skip_out} || $out->check ) &&
- ( $args{skip_err} || $err->check ), $mess )
+ unless( builder()->ok( ( $args{skip_out} || $out->check ) &&
+ ( $args{skip_err} || $err->check ), $mess )
)
{
# print out the diagnostic information about why this
@@ -344,10 +381,10 @@ sub test_test {
local $_;
- $t->diag( map { "$_\n" } $out->complaint )
+ builder()->diag( map { "$_\n" } $out->complaint )
unless $args{skip_out} || $out->check;
- $t->diag( map { "$_\n" } $err->complaint )
+ builder()->diag( map { "$_\n" } $err->complaint )
unless $args{skip_err} || $err->check;
}
}
@@ -418,48 +455,114 @@ sub color {
=back
-=head1 BUGS
+=head1 NOTES
-Calls C<< Test::Builder->no_ending >> turning off the ending tests.
-This is needed as otherwise it will trip out because we've run more
-tests than we strictly should have and it'll register any failures we
-had that we were testing for as real failures.
+Thanks to Richard Clamp E<lt>richardc@unixbeard.netE<gt> for letting
+me use his testing system to try this module out on.
-The color function doesn't work unless L<Term::ANSIColor> is
-compatible with your terminal.
+=head1 SEE ALSO
-Bugs (and requests for new features) can be reported to the author
-though the CPAN RT system:
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Builder-Tester>
+L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>.
-=head1 AUTHOR
+=encoding utf8
-Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+=head1 SOURCE
-Some code taken from L<Test::More> and L<Test::Catch>, written by
-Michael G Schwern E<lt>schwern@pobox.comE<gt>. Hence, those parts
-Copyright Micheal G Schwern 2001. Used and distributed with
-permission.
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
-This program is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself.
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
-=head1 MAINTAINERS
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
=back
-=head1 NOTES
+=head1 COPYRIGHT
-Thanks to Richard Clamp E<lt>richardc@unixbeard.netE<gt> for letting
-me use his testing system to try this module out on.
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
-=head1 SEE ALSO
+=over 4
-L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>.
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
=cut
@@ -487,8 +590,10 @@ sub expect {
sub _account_for_subtest {
my( $self, $check ) = @_;
+ my $ctx = Test::Stream::Context::context();
+ my $depth = @{$ctx->stream->subtests};
# Since we ship with Test::Builder, calling a private method is safe...ish.
- return ref($check) ? $check : $t->_indent . $check;
+ return ref($check) ? $check : ($depth ? ' ' x $depth : '') . $check;
}
sub _translate_Failed_check {
diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
index 4cb3b15ed9..774e16a1be 100644
--- a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
+++ b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
@@ -1,7 +1,8 @@
package Test::Builder::Tester::Color;
use strict;
-our $VERSION = "1.24";
+our $VERSION = '1.301001_063';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
require Test::Builder::Tester;
@@ -49,3 +50,105 @@ L<Test::Builder::Tester>, L<Term::ANSIColor>
=cut
1;
+
+__END__
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/FAQ.pod b/cpan/Test-Simple/lib/Test/FAQ.pod
new file mode 100644
index 0000000000..232ec99b26
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/FAQ.pod
@@ -0,0 +1,477 @@
+=head1 NAME
+
+Test::FAQ - Frequently Asked Questions about testing with Perl
+
+=head1 DESCRIPTION
+
+Frequently Asked Questions about testing in general and specific
+issues with Perl.
+
+=head2 Is there any tutorial on testing?
+
+L<Test::Tutorial>
+
+=head2 Are there any modules for testing?
+
+A whole bunch. Start with L<Test::Simple> then move onto Test::More.
+
+Then go onto L<http://search.cpan.org> and search for "Test".
+
+Also check out L<Fennec>.
+
+=head2 Are there any modules for testing web pages/CGI programs?
+
+L<Test::WWW::Mechanize>, L<Test::WWW::Selenium>
+
+=head2 Are there any modules for testing external programs?
+
+L<Test::Cmd>
+
+=head2 Can you do xUnit/JUnit style testing in Perl?
+
+Yes, L<Test::Class> allows you to write test methods while continuing to
+use all the usual CPAN testing modules. It is the best and most
+perlish way to do xUnit style testing.
+
+L<Test::Unit> is a more direct port of XUnit to Perl, but it does not use
+the Perl conventions and does not play well with other CPAN testing
+modules. As of this writing, it is abandoned. B<Do not use>.
+
+The L<Test::Inline> (aka L<Pod::Tests>) is worth mentioning as it allows you to
+put tests into the POD in the same file as the code.
+
+
+=head2 How do I test my module is backwards/forwards compatible?
+
+First, install a bunch of perls of commonly used versions. At the
+moment, you could try these
+
+ 5.7.2
+ 5.6.1
+ 5.005_03
+ 5.004_05
+
+if you're feeling brave, you might want to have on hand these
+
+ bleadperl
+ 5.6.0
+ 5.004_04
+ 5.004
+
+going back beyond 5.003 is probably beyond the call of duty.
+
+You can then add something like this to your F<Makefile.PL>. It
+overrides the L<ExtUtils::MakeMaker> C<test_via_harness()> method to run the tests
+against several different versions of Perl.
+
+ # If PERL_TEST_ALL is set, run "make test" against
+ # other perls as well as the current perl.
+ {
+ package MY;
+
+ sub test_via_harness {
+ my($self, $orig_perl, $tests) = @_;
+
+ # names of your other perl binaries.
+ my @other_perls = qw(perl5.004_05 perl5.005_03 perl5.7.2);
+
+ my @perls = ($orig_perl);
+ push @perls, @other_perls if $ENV{PERL_TEST_ALL};
+
+ my $out;
+ foreach my $perl (@perls) {
+ $out .= $self->SUPER::test_via_harness($perl, $tests);
+ }
+
+ return $out;
+ }
+ }
+
+and re-run your F<Makefile.PL> with the C<PERL_TEST_ALL> environment
+variable set
+
+ PERL_TEST_ALL=1 perl Makefile.PL
+
+now C<make test> will run against each of your other perls.
+
+
+=head2 If I'm testing Foo::Bar, where do I put tests for Foo::Bar::Baz?
+
+=head2 How do I know when my tests are good enough?
+
+A: Use tools for measuring the code coverage of your tests, e.g. how many of
+your source code lines/subs/expressions/paths are executed (aka covered) by
+the test suite. The more, the better, of course, although you may not
+be able achieve 100%. If your testsuite covers under 100%, then
+the rest of your code is, basically, untested. Which means it may work in
+surprising ways (e.g. doesn't do things like they are intended or
+documented), have bugs (e.g. return wrong results) or it may not work at
+all.
+
+=head2 How do I measure the coverage of my test suite?
+
+L<Devel::Cover>
+
+=head2 How do I get tests to run in a certain order?
+
+Tests run in alphabetical order, so simply name your test files in the order
+you want them to run. Numbering your test files works, too.
+
+ t/00_compile.t
+ t/01_config.t
+ t/zz_teardown.t
+
+0 runs first, z runs last.
+
+To achieve a specific order, try L<Test::Manifest>.
+
+Typically you do B<not> want your tests to require being run in a
+certain order, but it can be useful to do a compile check first or to
+run the tests on a very basic module before everything else. This
+gives you early information if a basic module fails which will bring
+everything else down.
+
+Another use is if you have a suite wide setup/teardown, such as
+creating and delete a large test database, which may be too
+expensive to do for every test.
+
+We recommend B<against> numbering every test file. For most files
+this ordering will be arbitrary and the leading number obscures the
+real name of the file. See L<What should I name my test files?> for
+more information.
+
+
+=head2 What should I name my tests?
+
+=head2 What should I name my test files?
+
+A test filename serves three purposes:
+
+Most importantly, it serves to identify what is being tested. Each
+test file should test a clear piece of functionality. This could be
+at single class, a single method, even a single bug.
+
+The order in which tests are run is usually dictated by the filename.
+See L<How do I get tests to run in a certain order?> for details.
+
+Finally, the grouping of tests into common bits of functionality can
+be achieved by directory and filenames. For example, all the tests
+for L<Test::Builder> are in the F<t/Builder/> directory.
+
+As an example, F<t/Builder/reset.t> contains the tests for
+C<< Test::Builder->reset >>. F<t/00compile.t> checks that everything
+compiles, and it will run first. F<t/dont_overwrite_die_handler.t>
+checks that we don't overwrite the C<< $SIG{__DIE__} >> handler.
+
+
+=head2 How do I deal with tests that sometimes pass and sometimes fail?
+
+=head2 How do I test with a database/network/server that the user may or may not have?
+
+=head2 What's a good way to test lists?
+
+C<is_deeply()> from L<Test::More> as well as L<Test::Deep>.
+
+=head2 Is there such a thing as untestable code?
+
+There's always compile/export checks.
+
+Code must be written with testability in mind. Separation of form and
+functionality.
+
+=head2 What do I do when I can't make the code do the same thing twice?
+
+Force it to do the same thing twice.
+
+Even a random number generator can be tested.
+
+=head2 How do I test a GUI?
+
+=head2 How do I test an image generator?
+
+=head2 How do I test that my code handles failures gracefully?
+
+=head2 How do I check the right warnings are issued?
+
+L<Test::Warn>
+
+=head2 How do I test code that prints?
+
+L<Test::Output>
+
+=head2 I want to test that my code dies when I do X
+
+L<Test::Exception>
+
+=head2 I want to print out more diagnostic info on failure.
+
+C<ok(...) || diag "...";>
+
+=head2 How can I simulate failures to make sure that my code does the Right Thing in the face of them?
+
+
+=head2 Why use an ok() function?
+
+On Tue, Aug 28, 2001 at 02:12:46PM +0100, Robin Houston wrote:
+> Michael Schwern wrote:
+> > Ah HA! I've been wondering why nobody ever thinks to write a simple
+> > ok() function for their tests! perlhack has bad testing advice.
+>
+> Could you explain the advantage of having a "simple ok() function"?
+
+Because writing:
+
+ print "not " unless some thing worked;
+ print "ok $test\n"; $test++;
+
+gets rapidly annoying. This is why we made up subroutines in the
+first place. It also looks like hell and obscures the real purpose.
+
+Besides, that will cause problems on VMS.
+
+
+> As somebody who has spent many painful hours debugging test failures,
+> I'm intimately familiar with the _disadvantages_. When you run the
+> test, you know that "test 113 failed". That's all you know, in general.
+
+Second advantage is you can easily upgrade the C<ok()> function to fix
+this, either by slapping this line in:
+
+ printf "# Failed test at line %d\n", (caller)[2];
+
+or simply junking the whole thing and switching to L<Test::Simple> or
+L<Test::More>, which does all sorts of nice diagnostics-on-failure for
+you. Its C<ok()> function is backwards compatible with the above.
+
+There's some issues with using L<Test::Simple> to test really basic Perl
+functionality, you have to choose on a per test basis. Since
+L<Test::Simple> doesn't use C<pack()> it's safe for F<t/op/pack.t> to use
+L<Test::Simple>. I just didn't want to make the perlhack patching
+example too complicated.
+
+
+=head2 Dummy Mode
+
+> One compromise would be to use a test-generating script, which allows
+> the tests to be structured simply and _generates_ the actual test
+> code. One could then grep the generated test script to locate the
+> failing code.
+
+This is a very interesting, and very common, response to the problem.
+I'm going to make some observations about reactions to testing,
+they're not specific to you.
+
+If you've ever read the Bastard Operator From Hell series, you'll
+recall the Dummy Mode.
+
+ The words "power surging" and "drivers" have got her. People hear
+ words like that and go into Dummy Mode and do ANYTHING you say. I
+ could tell her to run naked across campus with a powercord rammed
+ up her backside and she'd probably do it... Hmmm...
+
+There seems to be a Dummy Mode WRT testing. An otherwise competent
+person goes to write a test and they suddenly forget all basic
+programming practice.
+
+
+The reasons for using an C<ok()> function above are the same reasons to
+use functions in general, we should all know them. We'd laugh our
+heads off at code that repeated as much as your average test does.
+These are newbie mistakes.
+
+And the normal 'can do' flair seems to disappear. I know Robin. I
+*know* that in any other situation he would have come up with the
+C<caller()> trick in about 15 seconds flat. Instead weird, elaborate,
+inelegant hacks are thought up to solve the simplest problems.
+
+
+I guess there are certain programming idioms that are foreign enough
+to throw your brain into reverse if you're not ready for them. Like
+trying to think in Lisp, for example. Or being presented with OO for
+the first time. I guess writing test is one of those.
+
+
+=head2 How do I use Test::More without depending on it?
+
+Install L<Test::More> into F<t/lib> under your source directory. Then in your tests
+say C<use lib 't/lib'>.
+
+=head2 How do I deal with threads and forking?
+
+ use Test::More qw/enable_forking/;
+
+or
+
+ use Test::More qw/modern/;
+
+=head2 Why do I need more than ok?
+
+Since every test can be reduced to checking if a statement is true,
+C<ok()> can test everything. But C<ok()> doesn't tell you why the test
+failed. For that you need to tell the test more... which is why
+you need L<Test::More>.
+
+ ok $pirate->name eq "Roberts", "person's name";
+
+ not ok 1 - person's name
+ # Failed test at pirates.t line 23.
+
+If the above fails, you don't know what C<< $person->name >> returned.
+You have to go in and add a C<diag> call. This is time consuming. If
+it's a heisenbug, it might not fail again! If it's a user reporting a
+test failure, they might not be bothered to hack the tests to give you
+more information.
+
+ is $person->name, "Roberts", "person's name";
+
+ not ok 1 - person's name
+ # Failed test at pirates.t line 23.
+ # got: 'Wesley'
+ # expected: 'Roberts'
+
+Using C<is> from L<Test::More> you now know what value you got and
+what value you expected.
+
+The most useful functions in L<Test::More> are C<is()>, C<like()> and C<is_deeply()>.
+
+
+=head2 What's wrong with C<print $test ? "ok" : "not ok">?
+
+=head2 How do I check for an infinite loop?
+
+On Mon, Mar 18, 2002 at 03:57:55AM -0500, Mark-Jason Dominus wrote:
+>
+> Michael The Schwern <schwern@pobox.com> says:
+> > Use alarm and skip the test if $Config{d_alarm} is false (see
+> > t/op/alarm.t for an example). If you think the infinite loop is due
+> > to a programming glitch, as opposed to a cross-platform issue, this
+> > will be enough.
+>
+> Thanks very much!
+>
+
+=head2 How can I check that flock works?
+
+=head2 How do I use the comparison functions of a testing module without it being a test?
+
+Any testing function based on L<Test::Builder>, most are, can be quieted so it does
+not do any testing. It simply returns true or false. Use the following code...
+
+ use Test::More; # or any testing module
+
+ use Test::Builder;
+ use File::Spec;
+
+ # Get the internal Test::Builder object
+ my $tb = Test::Builder->new;
+
+ $tb->plan("no_plan");
+
+ # Keep Test::Builder from displaying anything
+ $tb->no_diag(1);
+ $tb->no_ending(1);
+ $tb->no_header(1);
+ $tb->output( File::Spec->devnull );
+
+ # Now you can use the testing function.
+ print is_deeply( "foo", "bar" ) ? "Yes" : "No";
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm
index fbf864559d..7a2135c60b 100644
--- a/cpan/Test-Simple/lib/Test/More.pm
+++ b/cpan/Test-Simple/lib/Test/More.pm
@@ -1,97 +1,489 @@
package Test::More;
-use 5.006;
+use 5.008001;
use strict;
use warnings;
-#---- perlcritic exemptions. ----#
+our $VERSION = '1.301001_063';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-# We use a lot of subroutine prototypes
-## no critic (Subroutines::ProhibitSubroutinePrototypes)
+use Test::Stream::Carp qw/croak carp/;
+use Scalar::Util qw/blessed/;
+
+use Test::More::Tools;
+use Test::More::DeepCheck::Strict;
+
+use Test::Stream '-internal';
+use Test::Stream::Util qw/protect try spoof/;
+use Test::Stream::Toolset;
+use Test::Stream::Meta qw/MODERN/;
+
+use Test::Stream::Exporter;
+our $TODO;
+default_export '$TODO' => \$TODO;
+default_exports qw{
+ context
+ plan done_testing
+
+ ok
+ is isnt
+ like unlike
+ cmp_ok
+ is_deeply
+ eq_array eq_hash eq_set
+ can_ok isa_ok new_ok
+ pass fail
+ require_ok use_ok
+ subtest
+
+ explain
+
+ diag note
+
+ skip todo_skip
+ BAIL_OUT
+};
+Test::Stream::Exporter->cleanup;
+
+{
+ no warnings 'once';
+ $Test::Builder::Level ||= 1;
+}
-# Can't use Carp because it might cause C<use_ok()> to accidentally succeed
-# even though the module being used forgot to use Carp. Yes, this
-# actually happened.
-sub _carp {
- my( $file, $line ) = ( caller(1) )[ 1, 2 ];
- return warn @_, " at $file line $line\n";
+sub builder {
+ protect { require Test::Builder };
+ return Test::Builder->new;
}
-our $VERSION = '1.001008';
-$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+sub before_import {
+ my $class = shift;
+ my ($importer, $list) = @_;
+
+ my $meta = init_tester($importer);
+
+ protect {require Test::Builder} unless $meta->[MODERN];
+
+ my $context = context(1);
+ my $other = [];
+ my $idx = 0;
+
+ while ($idx <= $#{$list}) {
+ my $item = $list->[$idx++];
+ next unless $item;
+
+ if (defined $item and $item eq 'no_diag') {
+ Test::Stream->shared->set_no_diag(1);
+ }
+ elsif ($item eq 'tests') {
+ $context->plan($list->[$idx++]);
+ }
+ elsif ($item eq 'skip_all') {
+ $context->plan(0, 'SKIP', $list->[$idx++]);
+ }
+ elsif ($item eq 'no_plan') {
+ $context->plan(0, 'NO PLAN');
+ }
+ elsif ($item eq 'import') {
+ push @$other => @{$list->[$idx++]};
+ }
+ else {
+ carp("Unknown option: $item");
+ }
+ }
+
+ @$list = @$other;
+
+ return;
+}
+
+sub ok ($;$) {
+ my $ctx = context();
+ $ctx->ok(@_);
+ return $_[0] ? 1 : 0;
+}
+
+sub plan {
+ my ($directive, $arg) = @_;
+ my $ctx = context();
+
+ if ($directive eq 'tests') {
+ $ctx->plan($arg);
+ }
+ else {
+ $ctx->plan(0, $directive, $arg);
+ }
+}
+
+sub done_testing {
+ my ($num) = @_;
+ my $ctx = context();
+ $ctx->done_testing($num);
+}
+
+sub is($$;$) {
+ my ($got, $want, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = tmt->is_eq($got, $want);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+sub isnt ($$;$) {
+ my ($got, $forbid, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = tmt->isnt_eq($got, $forbid);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+{
+ no warnings 'once';
+ *isn't = \&isnt;
+ # ' to unconfuse syntax higlighters
+}
+
+sub like ($$;$) {
+ my ($got, $check, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = tmt->regex_check($got, $check, '=~');
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+sub unlike ($$;$) {
+ my ($got, $forbid, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = tmt->regex_check($got, $forbid, '!~');
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+sub cmp_ok($$$;$) {
+ my ($got, $type, $expect, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = tmt->cmp_check($got, $type, $expect);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+sub can_ok($@) {
+ my ($thing, @methods) = @_;
+ my $ctx = context();
+
+ my $class = ref $thing || $thing || '';
+ my ($ok, @diag);
+
+ if (!@methods) {
+ ($ok, @diag) = (0, " can_ok() called with no methods");
+ }
+ elsif (!$class) {
+ ($ok, @diag) = (0, " can_ok() called with empty class or reference");
+ }
+ else {
+ ($ok, @diag) = tmt->can_check($thing, $class, @methods);
+ }
+
+ my $name = (@methods == 1 && defined $methods[0])
+ ? "$class\->can('$methods[0]')"
+ : "$class\->can(...)";
+
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+sub isa_ok ($$;$) {
+ my ($thing, $class, $thing_name) = @_;
+ my $ctx = context();
+ $thing_name = "'$thing_name'" if $thing_name;
+ my ($ok, @diag) = tmt->isa_check($thing, $class, \$thing_name);
+ my $name = "$thing_name isa '$class'";
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+sub new_ok {
+ croak "new_ok() must be given at least a class" unless @_;
+ my ($class, $args, $object_name) = @_;
+ my $ctx = context();
+ my ($obj, $name, $ok, @diag) = tmt->new_check($class, $args, $object_name);
+ $ctx->ok($ok, $name, \@diag);
+ return $obj;
+}
+
+sub pass (;$) {
+ my $ctx = context();
+ return $ctx->ok(1, @_);
+}
+
+sub fail (;$) {
+ my $ctx = context();
+ return $ctx->ok(0, @_);
+}
+
+sub subtest {
+ my $ctx = context();
+ return tmt->subtest(@_);
+}
-use Test::Builder::Module 0.99;
-our @ISA = qw(Test::Builder::Module);
-our @EXPORT = qw(ok use_ok require_ok
- is isnt like unlike is_deeply
- cmp_ok
- skip todo todo_skip
- pass fail
- eq_array eq_hash eq_set
- $TODO
- plan
- done_testing
- can_ok isa_ok new_ok
- diag note explain
- subtest
- BAIL_OUT
-);
+sub explain {
+ my $ctx = context();
+ tmt->explain(@_);
+}
+
+sub diag {
+ my $ctx = context();
+ $ctx->diag($_) for @_;
+}
+
+sub note {
+ my $ctx = context();
+ $ctx->note($_) for @_;
+}
+
+sub skip {
+ my( $why, $how_many ) = @_;
+ my $ctx = context();
+
+ _skip($why, $how_many, 'skip', 1);
+
+ no warnings 'exiting';
+ last SKIP;
+}
+
+sub _skip {
+ my( $why, $how_many, $func, $bool ) = @_;
+ my $ctx = context();
+
+ my $plan = $ctx->stream->plan;
+
+ # If there is no plan we do not need to worry about counts
+ my $need_count = $plan ? !($plan->directive && $plan->directive eq 'NO PLAN') : 1;
+
+ $ctx->alert("$func() needs to know \$how_many tests are in the block")
+ if $need_count && !defined $how_many;
+
+ $ctx->alert("$func() was passed a non-numeric number of tests. Did you get the arguments backwards?")
+ if defined $how_many and $how_many =~ /\D/;
+
+ return unless $how_many || !$bool;
+
+ $ctx->set_skip($why);
+ $how_many ||= 1;
+ for( 1 .. $how_many ) {
+ $ctx->ok($bool, '');
+ }
+}
+
+sub todo_skip {
+ my($why, $how_many) = @_;
+
+ my $ctx = context();
+ $ctx->set_in_todo(1);
+ $ctx->set_todo($why);
+ _skip($why, $how_many, 'todo_skip', 0);
+
+ no warnings 'exiting';
+ last TODO;
+}
+
+sub BAIL_OUT {
+ my ($reason) = @_;
+ my $ctx = context();
+ $ctx->bail($reason);
+}
+
+sub is_deeply {
+ my ($got, $want, $name) = @_;
+
+ my $ctx = context();
+
+ unless( @_ == 2 or @_ == 3 ) {
+ my $msg = <<'WARNING';
+is_deeply() takes two or three args, you gave %d.
+This usually means you passed an array or hash instead
+of a reference to it
+WARNING
+ chop $msg; # clip off newline so carp() will put in line/file
+
+ $ctx->alert(sprintf $msg, scalar @_);
+
+ $ctx->ok(0, undef, ['incorrect number of args']);
+ return 0;
+ }
+
+ my ($ok, @diag) = Test::More::DeepCheck::Strict->check($got, $want);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+sub eq_array {
+ my ($got, $want, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = Test::More::DeepCheck::Strict->check_array($got, $want);
+ return $ok;
+}
+
+sub eq_hash {
+ my ($got, $want, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = Test::More::DeepCheck::Strict->check_hash($got, $want);
+ return $ok;
+}
+
+sub eq_set {
+ my ($got, $want, $name) = @_;
+ my $ctx = context();
+ my ($ok, @diag) = Test::More::DeepCheck::Strict->check_set($got, $want);
+ return $ok;
+}
+
+sub require_ok($;$) {
+ my($module) = shift;
+ my $ctx = context();
+
+ # Try to determine if we've been given a module name or file.
+ # Module names must be barewords, files not.
+ $module = qq['$module'] unless _is_module_name($module);
+
+ my ($ret, $err);
+ {
+ local $SIG{__DIE__};
+ ($ret, $err) = spoof [caller] => "require $module";
+ }
+
+ my @diag;
+ unless ($ret) {
+ chomp $err;
+ push @diag => <<" DIAG";
+ Tried to require '$module'.
+ Error: $err
+ DIAG
+ }
+
+ $ctx->ok( $ret, "require $module;", \@diag );
+ return $ret ? 1 : 0;
+}
+
+sub _is_module_name {
+ my $module = shift;
+
+ # Module names start with a letter.
+ # End with an alphanumeric.
+ # The rest is an alphanumeric or ::
+ $module =~ s/\b::\b//g;
+
+ return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
+}
+
+sub use_ok($;@) {
+ my ($module, @imports) = @_;
+ @imports = () unless @imports;
+ my $ctx = context();
+
+ my($pack, $filename, $line) = caller;
+ $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line
+
+ my ($ret, $err, $newdie, @diag);
+ {
+ local $SIG{__DIE__};
+
+ if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+ # probably a version check. Perl needs to see the bare number
+ # for it to work with non-Exporter based modules.
+ ($ret, $err) = spoof [$pack, $filename, $line] => "use $module $imports[0]";
+ }
+ else {
+ ($ret, $err) = spoof [$pack, $filename, $line] => "use $module \@args", @imports;
+ }
+
+ $newdie = $SIG{__DIE__};
+ }
+
+ $SIG{__DIE__} = $newdie if defined $newdie;
+
+ unless ($ret) {
+ chomp $err;
+ push @diag => <<" DIAG";
+ Tried to use '$module'.
+ Error: $err
+ DIAG
+ }
+
+ $ctx->ok($ret, "use $module;", \@diag);
+
+ return $ret ? 1 : 0;
+}
+
+1;
+
+__END__
=head1 NAME
-Test::More - yet another framework for writing test scripts
+Test::More - The defacto standard in unit testing tools.
=head1 SYNOPSIS
- use Test::More tests => 23;
- # or
- use Test::More skip_all => $reason;
- # or
- use Test::More; # see done_testing()
-
- require_ok( 'Some::Module' );
+ # Enabled forking, and removes expensive legacy support;
+ use Test::Stream;
- # Various ways to say "ok"
- ok($got eq $expected, $test_name);
+ # Load after Test::Stream to get the benefits of removed legacy
+ use Test::More;
- is ($got, $expected, $test_name);
- isnt($got, $expected, $test_name);
+ use ok 'Some::Module';
- # Rather than print STDERR "# here's what went wrong\n"
- diag("here's what went wrong");
+ can_ok($module, @methods);
+ isa_ok($object, $class);
- like ($got, qr/expected/, $test_name);
- unlike($got, qr/expected/, $test_name);
+ pass($test_name);
+ fail($test_name);
- cmp_ok($got, '==', $expected, $test_name);
+ ok($got eq $expected, $test_name);
- is_deeply($got_complex_structure, $expected_complex_structure, $test_name);
+ is ($got, $expected, $test_name);
+ isnt($got, $expected, $test_name);
- SKIP: {
- skip $why, $how_many unless $have_some_feature;
+ like ($got, qr/expected/, $test_name);
+ unlike($got, qr/expected/, $test_name);
- ok( foo(), $test_name );
- is( foo(42), 23, $test_name );
- };
+ cmp_ok($got, '==', $expected, $test_name);
- TODO: {
- local $TODO = $why;
+ is_deeply(
+ $got_complex_structure,
+ $expected_complex_structure,
+ $test_name
+ );
- ok( foo(), $test_name );
- is( foo(42), 23, $test_name );
- };
+ # Rather than print STDERR "# here's what went wrong\n"
+ diag("here's what went wrong");
- can_ok($module, @methods);
- isa_ok($object, $class);
+ SKIP: {
+ skip $why, $how_many unless $have_some_feature;
- pass($test_name);
- fail($test_name);
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
- BAIL_OUT($why);
+ TODO: {
+ local $TODO = $why;
+
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
+
+ sub my_compare {
+ my ($got, $want, $name) = @_;
+ my $ctx = context();
+ my $ok = $got eq $want;
+ $ctx->ok($ok, $name);
+ ...
+ return $ok;
+ };
- # UNIMPLEMENTED!!!
- my @status = Test::More::status;
+ # If this fails it will report this line instead of the line in my_compare.
+ my_compare('a', 'b');
+ done_testing;
=head1 DESCRIPTION
@@ -105,7 +497,6 @@ facilities to skip tests, test future features and compare complicated
data structures. While you can do almost anything with a simple
C<ok()> function, it doesn't provide good diagnostic output.
-
=head2 I love it when a plan comes together
Before anything else, you need a testing plan. This basically declares
@@ -160,40 +551,6 @@ or for deciding between running the tests at all:
plan tests => 42;
}
-=cut
-
-sub plan {
- my $tb = Test::More->builder;
-
- return $tb->plan(@_);
-}
-
-# This implements "use Test::More 'no_diag'" but the behavior is
-# deprecated.
-sub import_extra {
- my $class = shift;
- my $list = shift;
-
- my @other = ();
- my $idx = 0;
- while( $idx <= $#{$list} ) {
- my $item = $list->[$idx];
-
- if( defined $item and $item eq 'no_diag' ) {
- $class->builder->no_diag(1);
- }
- else {
- push @other, $item;
- }
-
- $idx++;
- }
-
- @$list = @other;
-
- return;
-}
-
=over 4
=item B<done_testing>
@@ -213,12 +570,111 @@ This is safer than and replaces the "no_plan" plan.
=back
-=cut
+=head2 Test::Stream
-sub done_testing {
- my $tb = Test::More->builder;
- $tb->done_testing(@_);
-}
+When you use Test::Stream, it enables support for forking in your tests. If it
+is loaded before Test::More then it will prevent the insertion of some legacy
+support shims, saving you memory and improving performance.
+
+ use Test::Stream;
+ use Test::More;
+
+=head2 TAP Encoding
+
+You can now control the encoding of your TAP output using Test::Stream.
+
+ use Test::Stream; # imports tap_encoding
+ use Test::More;
+
+ tap_encoding 'utf8';
+
+You can also just set 'utf8' it at import time
+
+ use Test::Stream 'utf8';
+
+or something other than utf8
+
+ use Test::Stream encoding => 'latin1';
+
+=over 4
+
+=item tap_encoding 'utf8';
+
+=item tap_encoding 'YOUR_ENCODING';
+
+=item tap_encoding 'xxx' => sub { ... };
+
+The C<tap_encoding($encoding)> function will ensure that any B<FUTURE> TAP
+output produced by I<This Package> will be output in the specified encoding.
+
+You may also provide a codeblock in which case the scope of the encoding change
+will only apply to that codeblock.
+
+B<Note>: This is effective only for the current package. Other packages can/may
+select other encodings for their TAP output. For packages where none is
+specified, the original STDOUT and STDERR settings are used, the results are
+unpredictable.
+
+B<Note>: The encoding of the TAP, it is necessary to set to match the
+locale of the encoding of the terminal.
+
+However, in tests code that are performed in a variety of environments,
+it can not be assumed in advance the encoding of the locale of the terminal,
+it is recommended how to set the encoding to your environment using the
+C<Encode::Locale> module.
+
+The following is an example of code.
+
+ use utf8;
+ use Test::Stream;
+ use Test::More;
+ use Encode::Locale;
+
+ tap_encoding('console_out');
+
+B<Note>: Filenames are a touchy subject:
+
+Different OS's and filesystems handle filenames differently. When you do not
+specify an encoding, the filename will be unmodified, you get whatever perl
+thinks it is. If you do specify an encoding, the filename will be assumed to be
+in that encoding, and an attempt will be made to unscramble it. If the
+unscrambling fails the original name will be used.
+
+This filename unscrambling is necessary for example on linux systems when you
+use utf8 encoding and a utf8 filename. Perl will read the bytes of the name,
+and treat them as bytes. if you then try to print the name to a utf8 handle it
+will treat each byte as a different character. Test::More attempts to fix this
+scrambling for you.
+
+=back
+
+=head2 Helpers
+
+Sometimes you want to write functions for things you do frequently that include
+calling ok() or other test functions. Doing this can make it hard to debug
+problems as failures will be reported in your sub, and not at the place where
+you called your sub. Now there is a solution to this, the
+L<Test::Stream::Context> object!.
+
+Test::More exports the C<context()> function which will return a context object
+for your use. The idea is that you generate a context object at the lowest
+level (the function you call from your test file). Deeper functions that need
+context will get the object you already generated, at least until the object
+falls out of scope or is undefined.
+
+ sub my_compare {
+ my ($got, $want, $name) = @_;
+ my $ctx = context();
+
+ # is() will find the context object above, instead of generating a new
+ # one. That way a failure will be reported to the correct line
+ is($got, $want);
+
+ # This time it will generate a new context object. That means a failure
+ # will report to this line.
+ $ctx = undef;
+ is($got, $want);
+ };
=head2 Test names
@@ -285,15 +741,6 @@ Should an C<ok()> fail, it will produce some diagnostics:
This is the same as L<Test::Simple>'s C<ok()> routine.
-=cut
-
-sub ok ($;$) {
- my( $test, $name ) = @_;
- my $tb = Test::More->builder;
-
- return $tb->ok( $test, $name );
-}
-
=item B<is>
=item B<isnt>
@@ -368,23 +815,6 @@ different from some other value:
For those grammatical pedants out there, there's an C<isn't()>
function which is an alias of C<isnt()>.
-=cut
-
-sub is ($$;$) {
- my $tb = Test::More->builder;
-
- return $tb->is_eq(@_);
-}
-
-sub isnt ($$;$) {
- my $tb = Test::More->builder;
-
- return $tb->isnt_eq(@_);
-}
-
-*isn't = \&isnt;
-# ' to unconfuse syntax higlighters
-
=item B<like>
like( $got, qr/expected/, $test_name );
@@ -413,14 +843,6 @@ Regex options may be placed on the end (C<'/expected/i'>).
Its advantages over C<ok()> are similar to that of C<is()> and C<isnt()>. Better
diagnostics on failure.
-=cut
-
-sub like ($$;$) {
- my $tb = Test::More->builder;
-
- return $tb->like(@_);
-}
-
=item B<unlike>
unlike( $got, qr/expected/, $test_name );
@@ -428,14 +850,6 @@ sub like ($$;$) {
Works exactly as C<like()>, only it checks if $got B<does not> match the
given pattern.
-=cut
-
-sub unlike ($$;$) {
- my $tb = Test::More->builder;
-
- return $tb->unlike(@_);
-}
-
=item B<cmp_ok>
cmp_ok( $got, $op, $expected, $test_name );
@@ -468,20 +882,11 @@ C<is()>'s use of C<eq> will interfere:
cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
-It's especially useful when comparing greater-than or smaller-than
+It's especially useful when comparing greater-than or smaller-than
relation between values:
cmp_ok( $some_value, '<=', $upper_limit );
-
-=cut
-
-sub cmp_ok($$$;$) {
- my $tb = Test::More->builder;
-
- return $tb->cmp_ok(@_);
-}
-
=item B<can_ok>
can_ok($module, @methods);
@@ -494,9 +899,9 @@ Checks to make sure the $module or $object can do these @methods
is almost exactly like saying:
- ok( Foo->can('this') &&
- Foo->can('that') &&
- Foo->can('whatever')
+ ok( Foo->can('this') &&
+ Foo->can('that') &&
+ Foo->can('whatever')
);
only without all the typing and with a better interface. Handy for
@@ -509,40 +914,6 @@ as one test. If you desire otherwise, use:
can_ok('Foo', $meth);
}
-=cut
-
-sub can_ok ($@) {
- my( $proto, @methods ) = @_;
- my $class = ref $proto || $proto;
- my $tb = Test::More->builder;
-
- unless($class) {
- my $ok = $tb->ok( 0, "->can(...)" );
- $tb->diag(' can_ok() called with empty class or reference');
- return $ok;
- }
-
- unless(@methods) {
- my $ok = $tb->ok( 0, "$class->can(...)" );
- $tb->diag(' can_ok() called with no methods');
- return $ok;
- }
-
- my @nok = ();
- foreach my $method (@methods) {
- $tb->_try( sub { $proto->can($method) } ) or push @nok, $method;
- }
-
- my $name = (@methods == 1) ? "$class->can('$methods[0]')" :
- "$class->can(...)" ;
-
- my $ok = $tb->ok( !@nok, $name );
-
- $tb->diag( map " $class->can('$_') failed\n", @nok );
-
- return $ok;
-}
-
=item B<isa_ok>
isa_ok($object, $class, $object_name);
@@ -575,88 +946,6 @@ The diagnostics of this test normally just refer to 'the object'. If
you'd like them to be more specific, you can supply an $object_name
(for example 'Test customer').
-=cut
-
-sub isa_ok ($$;$) {
- my( $thing, $class, $thing_name ) = @_;
- my $tb = Test::More->builder;
-
- my $whatami;
- if( !defined $thing ) {
- $whatami = 'undef';
- }
- elsif( ref $thing ) {
- $whatami = 'reference';
-
- local($@,$!);
- require Scalar::Util;
- if( Scalar::Util::blessed($thing) ) {
- $whatami = 'object';
- }
- }
- else {
- $whatami = 'class';
- }
-
- # We can't use UNIVERSAL::isa because we want to honor isa() overrides
- my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } );
-
- if($error) {
- die <<WHOA unless $error =~ /^Can't (locate|call) method "isa"/;
-WHOA! I tried to call ->isa on your $whatami and got some weird error.
-Here's the error.
-$error
-WHOA
- }
-
- # Special case for isa_ok( [], "ARRAY" ) and like
- if( $whatami eq 'reference' ) {
- $rslt = UNIVERSAL::isa($thing, $class);
- }
-
- my($diag, $name);
- if( defined $thing_name ) {
- $name = "'$thing_name' isa '$class'";
- $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined";
- }
- elsif( $whatami eq 'object' ) {
- my $my_class = ref $thing;
- $thing_name = qq[An object of class '$my_class'];
- $name = "$thing_name isa '$class'";
- $diag = "The object of class '$my_class' isn't a '$class'";
- }
- elsif( $whatami eq 'reference' ) {
- my $type = ref $thing;
- $thing_name = qq[A reference of type '$type'];
- $name = "$thing_name isa '$class'";
- $diag = "The reference of type '$type' isn't a '$class'";
- }
- elsif( $whatami eq 'undef' ) {
- $thing_name = 'undef';
- $name = "$thing_name isa '$class'";
- $diag = "$thing_name isn't defined";
- }
- elsif( $whatami eq 'class' ) {
- $thing_name = qq[The class (or class-like) '$thing'];
- $name = "$thing_name isa '$class'";
- $diag = "$thing_name isn't a '$class'";
- }
- else {
- die;
- }
-
- my $ok;
- if($rslt) {
- $ok = $tb->ok( 1, $name );
- }
- else {
- $ok = $tb->ok( 0, $name );
- $tb->diag(" $diag\n");
- }
-
- return $ok;
-}
-
=item B<new_ok>
my $obj = new_ok( $class );
@@ -676,31 +965,6 @@ If @args is not given, an empty list will be used.
This function only works on C<new()> and it assumes C<new()> will return
just a single object which isa C<$class>.
-=cut
-
-sub new_ok {
- my $tb = Test::More->builder;
- $tb->croak("new_ok() must be given at least a class") unless @_;
-
- my( $class, $args, $object_name ) = @_;
-
- $args ||= [];
-
- my $obj;
- my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
- if($success) {
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- isa_ok $obj, $class, $object_name;
- }
- else {
- $class = 'undef' if !defined $class;
- $tb->ok( 0, "$class->new() died" );
- $tb->diag(" Error was: $error");
- }
-
- return $obj;
-}
-
=item B<subtest>
subtest $name => \&code;
@@ -712,7 +976,7 @@ result of the whole subtest to determine if its ok or not ok.
For example...
use Test::More tests => 3;
-
+
pass("First test");
subtest 'An example subtest' => sub {
@@ -762,15 +1026,6 @@ subtests are equivalent:
done_testing();
};
-=cut
-
-sub subtest {
- my ($name, $subtests) = @_;
-
- my $tb = Test::More->builder;
- return $tb->subtest(@_);
-}
-
=item B<pass>
=item B<fail>
@@ -786,23 +1041,8 @@ C<ok(1)> and C<ok(0)>.
Use these very, very, very sparingly.
-=cut
-
-sub pass (;$) {
- my $tb = Test::More->builder;
-
- return $tb->ok( 1, @_ );
-}
-
-sub fail (;$) {
- my $tb = Test::More->builder;
-
- return $tb->ok( 0, @_ );
-}
-
=back
-
=head2 Module tests
Sometimes you want to test if a module, or a list of modules, can
@@ -810,12 +1050,44 @@ successfully load. For example, you'll often want a first test which
simply loads all the modules in the distribution to make sure they
work before going on to do more complicated testing.
-For such purposes we have C<use_ok> and C<require_ok>.
+For such purposes we have C<use ok 'module'>. C<use_ok> is still around, but is
+considered discouraged in favor of C<use ok 'module'>. C<require_ok> is also
+discouraged because it tries to guess if you gave it a file name or module
+name. C<require_ok>'s guessing mechanism is broken, but fixing it can break
+things.
=over 4
+=item B<use ok 'module'>
+
+=item B<use ok 'module', @args>
+
+ use ok 'Some::Module';
+ use ok 'Another::Module', qw/import_a import_b/;
+
+This will load the specified module and pass through any extra arguments to
+that module. This will also produce a test result.
+
+B<Note - Do not do this:>
+
+ my $class = 'My::Module';
+ use ok $class;
+
+The value 'My::Module' is not assigned to the C<$class> variable until
+run-time, but the C<use ok $class> statement is run at compile time. The result
+of this is that we try to load 'undef' as a module. This will generate an
+exception: C<'use ok' called with an empty argument, did you try to use a package name from an uninitialized variable?>
+
+If you must do something like this, here is a more-correct way:
+
+ my $class;
+ BEGIN { $class = 'My::Module' }
+ use ok $class;
+
=item B<require_ok>
+B<***DISCOURAGED***> - Broken guessing
+
require_ok($module);
require_ok($file);
@@ -839,53 +1111,10 @@ No exception will be thrown if the load fails.
require_ok $module or BAIL_OUT "Can't load $module";
}
-=cut
-
-sub require_ok ($) {
- my($module) = shift;
- my $tb = Test::More->builder;
-
- my $pack = caller;
-
- # Try to determine if we've been given a module name or file.
- # Module names must be barewords, files not.
- $module = qq['$module'] unless _is_module_name($module);
-
- my $code = <<REQUIRE;
-package $pack;
-require $module;
-1;
-REQUIRE
-
- my( $eval_result, $eval_error ) = _eval($code);
- my $ok = $tb->ok( $eval_result, "require $module;" );
-
- unless($ok) {
- chomp $eval_error;
- $tb->diag(<<DIAGNOSTIC);
- Tried to require '$module'.
- Error: $eval_error
-DIAGNOSTIC
-
- }
-
- return $ok;
-}
-
-sub _is_module_name {
- my $module = shift;
-
- # Module names start with a letter.
- # End with an alphanumeric.
- # The rest is an alphanumeric or ::
- $module =~ s/\b::\b//g;
-
- return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
-}
-
-
=item B<use_ok>
+B<***DISCOURAGED***> See C<use ok 'module'>
+
BEGIN { use_ok($module); }
BEGIN { use_ok($module, @imports); }
@@ -933,77 +1162,8 @@ import anything, use C<require_ok>.
BEGIN { require_ok "Foo" }
-=cut
-
-sub use_ok ($;@) {
- my( $module, @imports ) = @_;
- @imports = () unless @imports;
- my $tb = Test::More->builder;
-
- my( $pack, $filename, $line ) = caller;
- $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line
-
- my $code;
- if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
- # probably a version check. Perl needs to see the bare number
- # for it to work with non-Exporter based modules.
- $code = <<USE;
-package $pack;
-
-#line $line $filename
-use $module $imports[0];
-1;
-USE
- }
- else {
- $code = <<USE;
-package $pack;
-
-#line $line $filename
-use $module \@{\$args[0]};
-1;
-USE
- }
-
- my( $eval_result, $eval_error ) = _eval( $code, \@imports );
- my $ok = $tb->ok( $eval_result, "use $module;" );
-
- unless($ok) {
- chomp $eval_error;
- $@ =~ s{^BEGIN failed--compilation aborted at .*$}
- {BEGIN failed--compilation aborted at $filename line $line.}m;
- $tb->diag(<<DIAGNOSTIC);
- Tried to use '$module'.
- Error: $eval_error
-DIAGNOSTIC
-
- }
-
- return $ok;
-}
-
-sub _eval {
- my( $code, @args ) = @_;
-
- # Work around oddities surrounding resetting of $@ by immediately
- # storing it.
- my( $sigdie, $eval_result, $eval_error );
- {
- local( $@, $!, $SIG{__DIE__} ); # isolate eval
- $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval)
- $eval_error = $@;
- $sigdie = $SIG{__DIE__} || undef;
- }
- # make sure that $code got a chance to set $SIG{__DIE__}
- $SIG{__DIE__} = $sigdie if defined $sigdie;
-
- return( $eval_result, $eval_error );
-}
-
-
=back
-
=head2 Complex data structures
Not everything is a simple eq check or regex. There are times you
@@ -1034,112 +1194,6 @@ improve in the future.
L<Test::Differences> and L<Test::Deep> provide more in-depth functionality
along these lines.
-=cut
-
-our( @Data_Stack, %Refs_Seen );
-my $DNE = bless [], 'Does::Not::Exist';
-
-sub _dne {
- return ref $_[0] eq ref $DNE;
-}
-
-## no critic (Subroutines::RequireArgUnpacking)
-sub is_deeply {
- my $tb = Test::More->builder;
-
- unless( @_ == 2 or @_ == 3 ) {
- my $msg = <<'WARNING';
-is_deeply() takes two or three args, you gave %d.
-This usually means you passed an array or hash instead
-of a reference to it
-WARNING
- chop $msg; # clip off newline so carp() will put in line/file
-
- _carp sprintf $msg, scalar @_;
-
- return $tb->ok(0);
- }
-
- my( $got, $expected, $name ) = @_;
-
- $tb->_unoverload_str( \$expected, \$got );
-
- my $ok;
- if( !ref $got and !ref $expected ) { # neither is a reference
- $ok = $tb->is_eq( $got, $expected, $name );
- }
- elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't
- $ok = $tb->ok( 0, $name );
- $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
- }
- else { # both references
- local @Data_Stack = ();
- if( _deep_check( $got, $expected ) ) {
- $ok = $tb->ok( 1, $name );
- }
- else {
- $ok = $tb->ok( 0, $name );
- $tb->diag( _format_stack(@Data_Stack) );
- }
- }
-
- return $ok;
-}
-
-sub _format_stack {
- my(@Stack) = @_;
-
- my $var = '$FOO';
- my $did_arrow = 0;
- foreach my $entry (@Stack) {
- my $type = $entry->{type} || '';
- my $idx = $entry->{'idx'};
- if( $type eq 'HASH' ) {
- $var .= "->" unless $did_arrow++;
- $var .= "{$idx}";
- }
- elsif( $type eq 'ARRAY' ) {
- $var .= "->" unless $did_arrow++;
- $var .= "[$idx]";
- }
- elsif( $type eq 'REF' ) {
- $var = "\${$var}";
- }
- }
-
- my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
- my @vars = ();
- ( $vars[0] = $var ) =~ s/\$FOO/ \$got/;
- ( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
-
- my $out = "Structures begin differing at:\n";
- foreach my $idx ( 0 .. $#vals ) {
- my $val = $vals[$idx];
- $vals[$idx]
- = !defined $val ? 'undef'
- : _dne($val) ? "Does not exist"
- : ref $val ? "$val"
- : "'$val'";
- }
-
- $out .= "$vars[0] = $vals[0]\n";
- $out .= "$vars[1] = $vals[1]\n";
-
- $out =~ s/^/ /msg;
- return $out;
-}
-
-sub _type {
- my $thing = shift;
-
- return '' if !ref $thing;
-
- for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE)) {
- return $type if UNIVERSAL::isa( $thing, $type );
- }
-
- return '';
-}
=back
@@ -1194,16 +1248,6 @@ don't indicate a problem.
note("Tempfile is $tempfile");
-=cut
-
-sub diag {
- return Test::More->builder->diag(@_);
-}
-
-sub note {
- return Test::More->builder->note(@_);
-}
-
=item B<explain>
my @dump = explain @diagnostic_message;
@@ -1220,12 +1264,6 @@ or
note explain \%args;
Some::Class->method(%args);
-=cut
-
-sub explain {
- return Test::More->builder->explain(@_);
-}
-
=back
@@ -1233,7 +1271,7 @@ sub explain {
Sometimes running a test under certain conditions will cause the
test script to die. A certain function or method isn't implemented
-(such as C<fork()> on MacOS), some resource isn't available (like a
+(such as C<fork()> on MacOS), some resource isn't available (like a
net connection) or a module isn't available. In these cases it's
necessary to skip tests, or declare that they are supposed to fail
but will work in the future (a todo test).
@@ -1286,34 +1324,6 @@ You don't skip tests which are failing because there's a bug in your
program, or for which you don't yet have code written. For that you
use TODO. Read on.
-=cut
-
-## no critic (Subroutines::RequireFinalReturn)
-sub skip {
- my( $why, $how_many ) = @_;
- my $tb = Test::More->builder;
-
- unless( defined $how_many ) {
- # $how_many can only be avoided when no_plan is in use.
- _carp "skip() needs to know \$how_many tests are in the block"
- unless $tb->has_plan eq 'no_plan';
- $how_many = 1;
- }
-
- if( defined $how_many and $how_many =~ /\D/ ) {
- _carp
- "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
- $how_many = 1;
- }
-
- for( 1 .. $how_many ) {
- $tb->skip($why);
- }
-
- no warnings 'exiting';
- last SKIP;
-}
-
=item B<TODO: BLOCK>
TODO: {
@@ -1370,26 +1380,6 @@ The syntax and behavior is similar to a C<SKIP: BLOCK> except the
tests will be marked as failing but todo. L<Test::Harness> will
interpret them as passing.
-=cut
-
-sub todo_skip {
- my( $why, $how_many ) = @_;
- my $tb = Test::More->builder;
-
- unless( defined $how_many ) {
- # $how_many can only be avoided when no_plan is in use.
- _carp "todo_skip() needs to know \$how_many tests are in the block"
- unless $tb->has_plan eq 'no_plan';
- $how_many = 1;
- }
-
- for( 1 .. $how_many ) {
- $tb->todo_skip($why);
- }
-
- no warnings 'exiting';
- last TODO;
-}
=item When do I use SKIP vs. TODO?
@@ -1425,18 +1415,8 @@ The test will exit with 255.
For even better control look at L<Test::Most>.
-=cut
-
-sub BAIL_OUT {
- my $reason = shift;
- my $tb = Test::More->builder;
-
- $tb->BAIL_OUT($reason);
-}
-
=back
-
=head2 Discouraged comparison functions
The use of the following functions is discouraged as they are not
@@ -1449,7 +1429,7 @@ These functions are usually used inside an C<ok()>.
ok( eq_array(\@got, \@expected) );
-C<is_deeply()> can do that better and with diagnostics.
+C<is_deeply()> can do that better and with diagnostics.
is_deeply( \@got, \@expected );
@@ -1464,146 +1444,6 @@ They may be deprecated in future versions.
Checks if two arrays are equivalent. This is a deep check, so
multi-level structures are handled correctly.
-=cut
-
-#'#
-sub eq_array {
- local @Data_Stack = ();
- _deep_check(@_);
-}
-
-sub _eq_array {
- my( $a1, $a2 ) = @_;
-
- if( grep _type($_) ne 'ARRAY', $a1, $a2 ) {
- warn "eq_array passed a non-array ref";
- return 0;
- }
-
- return 1 if $a1 eq $a2;
-
- my $ok = 1;
- my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
- for( 0 .. $max ) {
- my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
- my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
-
- next if _equal_nonrefs($e1, $e2);
-
- push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
- $ok = _deep_check( $e1, $e2 );
- pop @Data_Stack if $ok;
-
- last unless $ok;
- }
-
- return $ok;
-}
-
-sub _equal_nonrefs {
- my( $e1, $e2 ) = @_;
-
- return if ref $e1 or ref $e2;
-
- if ( defined $e1 ) {
- return 1 if defined $e2 and $e1 eq $e2;
- }
- else {
- return 1 if !defined $e2;
- }
-
- return;
-}
-
-sub _deep_check {
- my( $e1, $e2 ) = @_;
- my $tb = Test::More->builder;
-
- my $ok = 0;
-
- # Effectively turn %Refs_Seen into a stack. This avoids picking up
- # the same referenced used twice (such as [\$a, \$a]) to be considered
- # circular.
- local %Refs_Seen = %Refs_Seen;
-
- {
- $tb->_unoverload_str( \$e1, \$e2 );
-
- # Either they're both references or both not.
- my $same_ref = !( !ref $e1 xor !ref $e2 );
- my $not_ref = ( !ref $e1 and !ref $e2 );
-
- if( defined $e1 xor defined $e2 ) {
- $ok = 0;
- }
- elsif( !defined $e1 and !defined $e2 ) {
- # Shortcut if they're both undefined.
- $ok = 1;
- }
- elsif( _dne($e1) xor _dne($e2) ) {
- $ok = 0;
- }
- elsif( $same_ref and( $e1 eq $e2 ) ) {
- $ok = 1;
- }
- elsif($not_ref) {
- push @Data_Stack, { type => '', vals => [ $e1, $e2 ] };
- $ok = 0;
- }
- else {
- if( $Refs_Seen{$e1} ) {
- return $Refs_Seen{$e1} eq $e2;
- }
- else {
- $Refs_Seen{$e1} = "$e2";
- }
-
- my $type = _type($e1);
- $type = 'DIFFERENT' unless _type($e2) eq $type;
-
- if( $type eq 'DIFFERENT' ) {
- push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
- $ok = 0;
- }
- elsif( $type eq 'ARRAY' ) {
- $ok = _eq_array( $e1, $e2 );
- }
- elsif( $type eq 'HASH' ) {
- $ok = _eq_hash( $e1, $e2 );
- }
- elsif( $type eq 'REF' ) {
- push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
- $ok = _deep_check( $$e1, $$e2 );
- pop @Data_Stack if $ok;
- }
- elsif( $type eq 'SCALAR' ) {
- push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] };
- $ok = _deep_check( $$e1, $$e2 );
- pop @Data_Stack if $ok;
- }
- elsif($type) {
- push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
- $ok = 0;
- }
- else {
- _whoa( 1, "No type in _deep_check" );
- }
- }
- }
-
- return $ok;
-}
-
-sub _whoa {
- my( $check, $desc ) = @_;
- if($check) {
- die <<"WHOA";
-WHOA! $desc
-This should never happen! Please contact the author immediately!
-WHOA
- }
-}
-
=item B<eq_hash>
my $is_eq = eq_hash(\%got, \%expected);
@@ -1611,40 +1451,6 @@ WHOA
Determines if the two hashes contain the same keys and values. This
is a deep check.
-=cut
-
-sub eq_hash {
- local @Data_Stack = ();
- return _deep_check(@_);
-}
-
-sub _eq_hash {
- my( $a1, $a2 ) = @_;
-
- if( grep _type($_) ne 'HASH', $a1, $a2 ) {
- warn "eq_hash passed a non-hash ref";
- return 0;
- }
-
- return 1 if $a1 eq $a2;
-
- my $ok = 1;
- my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
- foreach my $k ( keys %$bigger ) {
- my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
- my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
-
- next if _equal_nonrefs($e1, $e2);
-
- push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
- $ok = _deep_check( $e1, $e2 );
- pop @Data_Stack if $ok;
-
- last unless $ok;
- }
-
- return $ok;
-}
=item B<eq_set>
@@ -1670,58 +1476,17 @@ level. The following is an example of a comparison which might not work:
L<Test::Deep> contains much better set comparison functions.
-=cut
-
-sub eq_set {
- my( $a1, $a2 ) = @_;
- return 0 unless @$a1 == @$a2;
-
- no warnings 'uninitialized';
-
- # It really doesn't matter how we sort them, as long as both arrays are
- # sorted with the same algorithm.
- #
- # Ensure that references are not accidentally treated the same as a
- # string containing the reference.
- #
- # Have to inline the sort routine due to a threading/sort bug.
- # See [rt.cpan.org 6782]
- #
- # I don't know how references would be sorted so we just don't sort
- # them. This means eq_set doesn't really work with refs.
- return eq_array(
- [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
- [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
- );
-}
-
=back
=head2 Extending and Embedding Test::More
Sometimes the Test::More interface isn't quite enough. Fortunately,
-Test::More is built on top of L<Test::Builder> which provides a single,
+Test::More is built on top of L<Test::Stream> which provides a single,
unified backend for any test library to use. This means two test
-libraries which both use <Test::Builder> B<can> be used together in the
+libraries which both use <Test::Stream> B<can> be used together in the
same program>.
-If you simply want to do a little tweaking of how the tests behave,
-you can access the underlying L<Test::Builder> object like so:
-
-=over 4
-
-=item B<builder>
-
- my $test_builder = Test::More->builder;
-
-Returns the L<Test::Builder> object underlying Test::More for you to play
-with.
-
-
-=back
-
-
=head1 EXIT CODES
If all your tests passed, L<Test::Builder> will exit with zero (which is
@@ -1750,31 +1515,53 @@ Test::More works with Perls as old as 5.8.1.
Thread support is not very reliable before 5.10.1, but that's
because threads are not very reliable before 5.10.1.
-Although Test::More has been a core module in versions of Perl since 5.6.2, Test::More has evolved since then, and not all of the features you're used to will be present in the shipped version of Test::More. If you are writing a module, don't forget to indicate in your package metadata the minimum version of Test::More that you require. For instance, if you want to use C<done_testing()> but want your test script to run on Perl 5.10.0, you will need to explicitly require Test::More > 0.88.
+Although Test::More has been a core module in versions of Perl since 5.6.2,
+Test::More has evolved since then, and not all of the features you're used to
+will be present in the shipped version of Test::More. If you are writing a
+module, don't forget to indicate in your package metadata the minimum version
+of Test::More that you require. For instance, if you want to use
+C<done_testing()> but want your test script to run on Perl 5.10.0, you will
+need to explicitly require Test::More > 0.88.
Key feature milestones include:
=over 4
+=item event stream
+
+=item forking support
+
+=item tap encoding
+
+Test::Builder and Test::More version 1.301001 introduce these major
+modernizations.
+
=item subtests
-Subtests were released in Test::More 0.94, which came with Perl 5.12.0. Subtests did not implicitly call C<done_testing()> until 0.96; the first Perl with that fix was Perl 5.14.0 with 0.98.
+Subtests were released in Test::More 0.94, which came with Perl 5.12.0.
+Subtests did not implicitly call C<done_testing()> until 0.96; the first Perl
+with that fix was Perl 5.14.0 with 0.98.
=item C<done_testing()>
-This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
+This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as
+part of Test::More 0.92.
=item C<cmp_ok()>
-Although C<cmp_ok()> was introduced in 0.40, 0.86 fixed an important bug to make it safe for overloaded objects; the fixed first shipped with Perl in 5.10.1 as part of Test::More 0.92.
+Although C<cmp_ok()> was introduced in 0.40, 0.86 fixed an important bug to
+make it safe for overloaded objects; the fixed first shipped with Perl in
+5.10.1 as part of Test::More 0.92.
=item C<new_ok()> C<note()> and C<explain()>
-These were was released in Test::More 0.82, and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
+These were was released in Test::More 0.82, and first shipped with Perl in
+5.10.1 as part of Test::More 0.92.
=back
-There is a full version history in the Changes file, and the Test::More versions included as core can be found using L<Module::CoreList>:
+There is a full version history in the Changes file, and the Test::More
+versions included as core can be found using L<Module::CoreList>:
$ corelist -a Test::More
@@ -1786,22 +1573,33 @@ There is a full version history in the Changes file, and the Test::More versions
=item utf8 / "Wide character in print"
If you use utf8 or other non-ASCII characters with Test::More you
-might get a "Wide character in print" warning. Using
-C<< binmode STDOUT, ":utf8" >> will not fix it.
-L<Test::Builder> (which powers
-Test::More) duplicates STDOUT and STDERR. So any changes to them,
-including changing their output disciplines, will not be seem by
-Test::More.
+might get a "Wide character in print" warning.
+Using C<< binmode STDOUT, ":utf8" >> will not fix it.
+
+Use the C<tap_encoding> function to configure the TAP stream encoding.
+
+ use utf8;
+ use Test::Stream; # imports tap_encoding
+ use Test::More;
+ tap_encoding 'utf8';
+
+L<Test::Builder> (which powers Test::More) duplicates STDOUT and STDERR.
+So any changes to them, including changing their output disciplines,
+will not be seen by Test::More.
+
+B<Note>:deprecated ways to use utf8 or other non-ASCII characters.
-One work around is to apply encodings to STDOUT and STDERR as early
-as possible and before Test::More (or any other Test module) loads.
+In the past it was necessary to alter the filehandle encoding prior to loading
+Test::More. This is no longer necessary thanks to C<tap_encoding()>.
+ # *** DEPRECATED WAY ***
use open ':std', ':encoding(utf8)';
use Test::More;
A more direct work around is to change the filehandles used by
L<Test::Builder>.
+ # *** EVEN MORE DEPRECATED WAY ***
my $builder = Test::More->builder;
binmode $builder->output, ":encoding(utf8)";
binmode $builder->failure_output, ":encoding(utf8)";
@@ -1825,6 +1623,11 @@ complex data structures.
=item Threads
+B<NOTE:> The underlying mechanism to support threads has changed as of version
+1.301001. Instead of sharing several variables and locking them, threads now
+use the same mechanism as forking support. The new system writes events to temp
+files which are culled by the main process.
+
Test::More will only be aware of threads if C<use threads> has been done
I<before> Test::More is loaded. This is ok:
@@ -1907,14 +1710,14 @@ L<Bundle::Test> installs a whole bunch of useful test modules.
L<Test::Most> Most commonly needed test functions and features.
-=head1 AUTHORS
+=encoding utf8
-Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
-from Joshua Pritikin's Test module and lots of help from Barrie
-Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
-the perl-qa gang.
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
-=head1 MAINTAINERS
+=head1 MAINTAINER
=over 4
@@ -1922,20 +1725,57 @@ the perl-qa gang.
=back
+=head1 AUTHORS
-=head1 BUGS
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
-See F<http://rt.cpan.org> to report and view bugs.
+=over 4
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
-=head1 SOURCE
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
-The source code repository for Test::More can be found at
-F<http://github.com/Test-More/test-more/>.
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+=item 唐鳳
+
+=back
=head1 COPYRIGHT
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
This program is free software; you can redistribute it and/or
@@ -1943,6 +1783,29 @@ modify it under the same terms as Perl itself.
See F<http://www.perl.com/perl/misc/Artistic.html>
-=cut
+=item Test::use::ok
-1;
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/More/DeepCheck.pm b/cpan/Test-Simple/lib/Test/More/DeepCheck.pm
new file mode 100644
index 0000000000..4ec03fa2bf
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/More/DeepCheck.pm
@@ -0,0 +1,223 @@
+package Test::More::DeepCheck;
+use strict;
+use warnings;
+
+use Test::Stream::ArrayBase(
+ accessors => [qw/seen/],
+);
+
+sub init {
+ $_[0]->[SEEN] ||= [{}];
+}
+
+my %PAIRS = ( '{' => '}', '[' => ']' );
+my $DNE = bless [], 'Does::Not::Exist';
+
+sub is_dne { ref $_[-1] eq ref $DNE }
+sub dne { $DNE };
+
+sub preface { "" };
+
+sub format_stack {
+ my $self = shift;
+ my $start = $self->STACK_START;
+ my $end = @$self - 1;
+
+ my @Stack = @{$self}[$start .. $end];
+
+ my @parts1 = (' $got');
+ my @parts2 = ('$expected');
+
+ my $did_arrow = 0;
+ for my $entry (@Stack) {
+ next unless $entry;
+ my $type = $entry->{type} || '';
+ my $idx = $entry->{idx};
+ my $key = $entry->{key};
+ my $wrap = $entry->{wrap};
+
+ if ($type eq 'HASH') {
+ unless ($did_arrow) {
+ push @parts1 => '->';
+ push @parts2 => '->';
+ $did_arrow++;
+ }
+ push @parts1 => "{$idx}";
+ push @parts2 => "{$idx}";
+ }
+ elsif ($type eq 'OBJECT') {
+ push @parts1 => '->';
+ push @parts2 => '->';
+ push @parts1 => "$idx()";
+ push @parts2 => "{$idx}";
+ $did_arrow = 0;
+ }
+ elsif ($type eq 'ARRAY') {
+ unless ($did_arrow) {
+ push @parts1 => '->';
+ push @parts2 => '->';
+ $did_arrow++;
+ }
+ push @parts1 => "[$idx]";
+ push @parts2 => "[$idx]";
+ }
+ elsif ($type eq 'REF') {
+ unshift @parts1 => '${';
+ unshift @parts2 => '${';
+ push @parts1 => '}';
+ push @parts2 => '}';
+ }
+
+ if ($wrap) {
+ my $pair = $PAIRS{$wrap};
+ unshift @parts1 => $wrap;
+ unshift @parts2 => $wrap;
+ push @parts1 => $pair;
+ push @parts2 => $pair;
+ }
+ }
+
+ my $error = $Stack[-1]->{error};
+ chomp($error) if $error;
+
+ my @vals = @{$Stack[-1]{vals}}[0, 1];
+ my @vars = (
+ join('', @parts1),
+ join('', @parts2),
+ );
+
+ my $out = $self->preface;
+ for my $idx (0 .. $#vals) {
+ my $val = $vals[$idx];
+ $vals[$idx] =
+ !defined $val ? 'undef'
+ : is_dne($val) ? "Does not exist"
+ : ref $val ? "$val"
+ : "'$val'";
+ }
+
+ $out .= "$vars[0] = $vals[0]\n";
+ $out .= "$vars[1] = $vals[1]\n";
+ $out .= "$error\n" if $error;
+
+ $out =~ s/^/ /msg;
+ return $out;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::More::DeepCheck - Base class or is_deeply() and mostly_like()
+implementations.
+
+=head1 DESCRIPTION
+
+This is the base class for deep check functions provided by L<Test::More> and
+L<Test::MostlyLike>. This class contains all the debugging and diagnostics
+code shared betweent he 2 tools.
+
+Most of this was refactored from the original C<is_deeply()> implementation. If
+you find any bugs or incompatabilities please report them.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/More/DeepCheck/Strict.pm b/cpan/Test-Simple/lib/Test/More/DeepCheck/Strict.pm
new file mode 100644
index 0000000000..e019d4e40f
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/More/DeepCheck/Strict.pm
@@ -0,0 +1,328 @@
+package Test::More::DeepCheck::Strict;
+use strict;
+use warnings;
+
+use Scalar::Util qw/reftype/;
+use Test::More::Tools;
+use Test::Stream::Carp qw/cluck confess/;
+use Test::Stream::Util qw/try unoverload_str is_regex/;
+
+use Test::Stream::ArrayBase(
+ accessors => [qw/stack_start/],
+ base => 'Test::More::DeepCheck',
+);
+
+sub preface { "Structures begin differing at:\n" }
+
+sub check {
+ my $class = shift;
+ my ($got, $expect) = @_;
+
+ unoverload_str(\$got, \$expect);
+ my $self = $class->new();
+
+ # neither is a reference
+ return tmt->is_eq($got, $expect)
+ if !ref $got and !ref $expect;
+
+ # one's a reference, one isn't
+ if (!ref $got xor !ref $expect) {
+ push @$self => {vals => [$got, $expect], line => __LINE__};
+ return (0, $self->format_stack);
+ }
+
+ push @$self => {vals => [$got, $expect], line => __LINE__};
+ my $ok = $self->_deep_check($got, $expect);
+ return ($ok, $ok ? () : $self->format_stack);
+}
+
+sub check_array {
+ my $class = shift;
+ my ($got, $expect) = @_;
+ my $self = $class->new();
+ push @$self => {vals => [$got, $expect], line => __LINE__};
+ my $ok = $self->_deep_check($got, $expect);
+ return ($ok, $ok ? () : $self->format_stack);
+}
+
+sub check_hash {
+ my $class = shift;
+ my ($got, $expect) = @_;
+ my $self = $class->new();
+ push @$self => {vals => [$got, $expect], line => __LINE__};
+ my $ok = $self->_deep_check($got, $expect);
+ return ($ok, $ok ? () : $self->format_stack);
+}
+
+sub check_set {
+ my $class = shift;
+ my ($got, $expect) = @_;
+
+ return 0 unless @$got == @$expect;
+
+ no warnings 'uninitialized';
+
+ # It really doesn't matter how we sort them, as long as both arrays are
+ # sorted with the same algorithm.
+ #
+ # Ensure that references are not accidentally treated the same as a
+ # string containing the reference.
+ #
+ # Have to inline the sort routine due to a threading/sort bug.
+ # See [rt.cpan.org 6782]
+ #
+ # I don't know how references would be sorted so we just don't sort
+ # them. This means eq_set doesn't really work with refs.
+ return $class->check_array(
+ [ grep( ref, @$got ), sort( grep( !ref, @$got ) ) ],
+ [ grep( ref, @$expect ), sort( grep( !ref, @$expect ) ) ],
+ );
+}
+
+sub _deep_check {
+ my $self = shift;
+ confess "XXX" unless ref $self;
+ my($e1, $e2) = @_;
+
+ unoverload_str( \$e1, \$e2 );
+
+ # Either they're both references or both not.
+ my $same_ref = !(!ref $e1 xor !ref $e2);
+ my $not_ref = (!ref $e1 and !ref $e2);
+
+ return 0 if defined $e1 xor defined $e2;
+ return 1 if !defined $e1 and !defined $e2; # Shortcut if they're both undefined.
+ return 0 if $self->is_dne($e1) xor $self->is_dne($e2);
+ return 1 if $same_ref and ($e1 eq $e2);
+
+ if ($not_ref) {
+ push @$self => {type => '', vals => [$e1, $e2], line => __LINE__};
+ return 0;
+ }
+
+ # This avoids picking up the same referenced used twice (such as
+ # [\$a, \$a]) to be considered circular.
+ my $seen = {%{$self->[SEEN]->[-1]}};
+ push @{$self->[SEEN]} => $seen;
+ my $ok = $self->_inner_check($seen, $e1, $e2);
+ pop @{$self->[SEEN]};
+ return $ok;
+}
+
+sub _inner_check {
+ my $self = shift;
+ my ($seen, $e1, $e2) = @_;
+
+ return $seen->{$e1} if $seen->{$e1} && $seen->{$e1} eq $e2;
+ $seen->{$e1} = "$e2";
+
+ my $type1 = reftype($e1) || '';
+ my $type2 = reftype($e2) || '';
+ my $diff = $type1 ne $type2;
+
+ if ($diff) {
+ push @$self => {type => 'DIFFERENT', vals => [$e1, $e2], line => __LINE__};
+ return 0;
+ }
+
+ return $self->_check_array($e1, $e2) if $type1 eq 'ARRAY';
+ return $self->_check_hash($e1, $e2) if $type1 eq 'HASH';
+
+ if ($type1 eq 'REF' || $type1 eq 'SCALAR' && !(is_regex($e1) && is_regex($e2))) {
+ push @$self => {type => 'REF', vals => [$e1, $e2], line => __LINE__};
+ my $ok = $self->_deep_check($$e1, $$e2);
+ pop @$self if $ok;
+ return $ok;
+ }
+
+ push @$self => {type => $type1, vals => [$e1, $e2], line => __LINE__};
+ return 0;
+}
+
+sub _check_array {
+ my $self = shift;
+ my ($a1, $a2) = @_;
+
+ if (grep reftype($_) ne 'ARRAY', $a1, $a2) {
+ cluck "_check_array passed a non-array ref";
+ return 0;
+ }
+
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+ for (0 .. $max) {
+ my $e1 = $_ > $#$a1 ? $self->dne : $a1->[$_];
+ my $e2 = $_ > $#$a2 ? $self->dne : $a2->[$_];
+
+ next if $self->_check_nonrefs($e1, $e2);
+
+ push @$self => {type => 'ARRAY', idx => $_, vals => [$e1, $e2], line => __LINE__};
+ $ok = $self->_deep_check($e1, $e2);
+ pop @$self if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+sub _check_nonrefs {
+ my $self = shift;
+ my($e1, $e2) = @_;
+
+ return if ref $e1 or ref $e2;
+
+ if (defined $e1) {
+ return 1 if defined $e2 and $e1 eq $e2;
+ }
+ else {
+ return 1 if !defined $e2;
+ }
+
+ return 0;
+}
+
+sub _check_hash {
+ my $self = shift;
+ my ($a1, $a2) = @_;
+
+ if (grep {(reftype($_) || '') ne 'HASH' } $a1, $a2) {
+ cluck "_check_hash passed a non-hash ref";
+ return 0;
+ }
+
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+ for my $k (sort keys %$bigger) {
+ my $e1 = exists $a1->{$k} ? $a1->{$k} : $self->dne;
+ my $e2 = exists $a2->{$k} ? $a2->{$k} : $self->dne;
+
+ next if $self->_check_nonrefs($e1, $e2);
+
+ push @$self => {type => 'HASH', idx => $k, vals => [$e1, $e2], line => __LINE__};
+ $ok = $self->_deep_check($e1, $e2);
+ pop @$self if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::More::DeepCheck::Strict - Where is_deeply() is implemented.
+
+=head1 DESCRIPTION
+
+This is the package where the code for C<is_deeply()> from L<Test::More> lives.
+This code was refactored into this form, but should remain 100% compatible with
+the old implementation. If you find an incompatability please report it.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/More/DeepCheck/Tolerant.pm b/cpan/Test-Simple/lib/Test/More/DeepCheck/Tolerant.pm
new file mode 100644
index 0000000000..2ae83115b3
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/More/DeepCheck/Tolerant.pm
@@ -0,0 +1,330 @@
+package Test::More::DeepCheck::Tolerant;
+use strict;
+use warnings;
+
+use Test::More::Tools;
+use Scalar::Util qw/reftype blessed/;
+use Test::Stream::Util qw/try unoverload_str is_regex/;
+
+use Test::Stream::ArrayBase(
+ accessors => [qw/stack_start/],
+ base => 'Test::More::DeepCheck',
+);
+
+sub preface { "First mismatch:\n" };
+
+sub check {
+ my $class = shift;
+ my ($got, $expect) = @_;
+
+ unoverload_str(\$got, \$expect);
+ my $self = $class->new();
+
+ # neither is a reference
+ return tmt->is_eq($got, $expect)
+ if !ref $got and !ref $expect;
+
+ push @$self => {type => '', vals => [$got, $expect], line => __LINE__};
+ my $ok = $self->_deep_check($got, $expect);
+ return ($ok, $ok ? () : $self->format_stack);
+}
+
+#============================
+
+sub _reftype {
+ my ($thing) = @_;
+ my $type = reftype $thing || return '';
+
+ $type = uc($type);
+
+ return $type unless $type eq 'SCALAR';
+
+ $type = 'REGEXP' if $type eq 'REGEX' || is_regex($thing);
+
+ return $type;
+}
+
+sub _nonref_check {
+ my ($self) = shift;
+ my ($got, $expect) = @_;
+
+ my $numeric = $got !~ m/\D/i && $expect !~ m/\D/i;
+ return $numeric ? $got == $expect : "$got" eq "$expect";
+}
+
+sub _deep_check {
+ my ($self) = shift;
+ my ($got, $expect) = @_;
+
+ return 1 unless defined($got) || defined($expect);
+ return 0 if defined($got) xor defined($expect);
+
+ my $seen = $self->[SEEN]->[-1];
+ return 1 if $seen->{$got} && $seen->{$got} eq $expect;
+ $seen->{$got} = "$expect";
+
+ my $etype = _reftype $expect;
+ my $gtype = _reftype $got;
+
+ return 0 if ($etype && $etype ne 'REGEXP' && !$gtype) || ($gtype && !$etype);
+
+ return $self->_nonref_check($got, $expect) unless $etype;
+
+ ##### Both are refs at this point ####
+ return 1 if $gtype && $got == $expect;
+
+ if ($etype eq 'REGEXP') {
+ return "$got" eq "$expect" if $gtype eq 'REGEXP'; # Identical regexp check
+ return $got =~ $expect;
+ }
+
+ my $ok = 0;
+ $seen = {%$seen};
+ push @{$self->[SEEN]} => $seen;
+ if ($etype eq 'ARRAY') {
+ $ok = $self->_array_check($got, $expect);
+ }
+ elsif ($etype eq 'HASH') {
+ $ok = $self->_hash_check($got, $expect);
+ }
+ pop @{$self->[SEEN]};
+
+ return $ok;
+}
+
+sub _array_check {
+ my $self = shift;
+ my ($got, $expect) = @_;
+
+ return 0 if _reftype($got) ne 'ARRAY';
+
+ for (my $i = 0; $i < @$expect; $i++) {
+ push @$self => {type => 'ARRAY', idx => $i, vals => [$got->[$i], $expect->[$i]], line => __LINE__};
+ $self->_deep_check($got->[$i], $expect->[$i]) || return 0;
+ pop @$self;
+ }
+
+ return 1;
+}
+
+sub _hash_check {
+ my $self = shift;
+ my ($got, $expect) = @_;
+
+ my $blessed = blessed($got);
+ my $hashref = _reftype($got) eq 'HASH';
+ my $arrayref = _reftype($got) eq 'ARRAY';
+
+ for my $key (sort keys %$expect) {
+ # $wrap $direct $field Leftover from wrap
+ my ($wrap, $direct, $field) = ($key =~ m/^ ([\[\{]?) (:?) ([^\]]*) [\]\}]?$/x);
+
+ if ($wrap) {
+ if (!$blessed) {
+ push @$self => {
+ type => 'OBJECT',
+ idx => $field,
+ wrap => $wrap,
+ vals => ["(EXCEPTION)", $expect->{$key}],
+ error => "Cannot call method '$field' on an unblessed reference.\n",
+ line => __LINE__,
+ };
+ return 0;
+ }
+ if ($direct) {
+ push @$self => {
+ type => 'OBJECT',
+ idx => $field,
+ wrap => $wrap,
+ vals => ['(EXCEPTION)', $expect->{$key}],
+ error => "'$key' is invalid, cannot wrap($wrap) a direct-access($direct).\n",
+ line => __LINE__,
+ };
+ return 0;
+ }
+ }
+
+ my ($val, $type);
+ if ($direct || !$blessed) {
+ if ($arrayref) {
+ $type = 'ARRAY';
+ if ($field !~ m/^-?\d+$/i) {
+ push @$self => {
+ type => 'ARRAY',
+ idx => $field,
+ vals => ['(EXCEPTION)', $expect->{$key}],
+ error => "'$field' is not a valid array index\n",
+ line => __LINE__,
+ };
+ return 0;
+ }
+
+ # Try, if they specify -1 in an empty array it may throw an exception
+ my ($success, $error) = try { $val = $got->[$field] };
+ if (!$success) {
+ push @$self => {
+ type => 'ARRAY',
+ idx => $field,
+ vals => ['(EXCEPTION)', $expect->{$key}],
+ error => $error,
+ line => __LINE__,
+ };
+ return 0;
+ }
+ }
+ else {
+ $type = 'HASH';
+ $val = $got->{$field};
+ }
+ }
+ else {
+ $type = 'OBJECT';
+ my ($success, $error) = try {
+ if ($wrap) {
+ if ($wrap eq '[') {
+ $val = [$got->$field()];
+ }
+ elsif ($wrap eq '{') {
+ $val = {$got->$field()};
+ }
+ else {
+ die "'$wrap' is not a valid way to wrap a method call";
+ }
+ }
+ else {
+ $val = $got->$field();
+ }
+ };
+ if (!$success) {
+ push @$self => {
+ type => 'OBJECT',
+ idx => $field,
+ wrap => $wrap || undef,
+ vals => ['(EXCEPTION)', $expect->{$key}],
+ error => $error,
+ line => __LINE__,
+ };
+ return 0;
+ }
+ }
+
+ push @$self => {type => $type, idx => $field, vals => [$val, $expect->{$key}], line => __LINE__, wrap => $wrap || undef};
+ $self->_deep_check($val, $expect->{$key}) || return 0;
+ pop @$self;
+ }
+
+ return 1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::More::DeepCheck::Tolerant - Under the hood implementation of
+mostly_like()
+
+=head1 DESCRIPTION
+
+This is where L<Test::MostlyLike> is implemented.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/More/Tools.pm b/cpan/Test-Simple/lib/Test/More/Tools.pm
new file mode 100644
index 0000000000..69074ce3d2
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/More/Tools.pm
@@ -0,0 +1,540 @@
+package Test::More::Tools;
+use strict;
+use warnings;
+
+use Test::Stream::Context;
+
+use Test::Stream::Exporter;
+default_exports qw/tmt/;
+Test::Stream::Exporter->cleanup;
+
+use Test::Stream::Util qw/try protect is_regex unoverload_str unoverload_num/;
+use Scalar::Util qw/blessed reftype/;
+
+sub tmt() { __PACKAGE__ }
+
+# Bad, these are not comparison operators. Should we include more?
+my %CMP_OK_BL = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "...");
+my %NUMERIC_CMPS = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
+
+sub cmp_check {
+ my($class, $got, $type, $expect) = @_;
+
+ my $ctx = context();
+ my $name = $ctx->subname;
+ $name =~ s/^.*:://g;
+ $name = 'cmp_check' if $name eq '__ANON__';
+ $ctx->throw("$type is not a valid comparison operator in $name\()")
+ if $CMP_OK_BL{$type};
+
+ my ($p, $file, $line) = $ctx->call;
+
+ my $test = 0;
+ my ($success, $error) = try {
+ # This is so that warnings come out at the caller's level
+ ## no critic (BuiltinFunctions::ProhibitStringyEval)
+ eval qq[
+#line $line "(eval in $name) $file"
+\$test = (\$got $type \$expect);
+1;
+ ] || die $@;
+ };
+
+ my @diag;
+ push @diag => <<" END" unless $success;
+An error occurred while using $type:
+------------------------------------
+$error
+------------------------------------
+ END
+
+ unless($test) {
+ # Treat overloaded objects as numbers if we're asked to do a
+ # numeric comparison.
+ my $unoverload = $NUMERIC_CMPS{$type}
+ ? \&unoverload_num
+ : \&unoverload_str;
+
+ $unoverload->(\$got, \$expect);
+
+ if( $type =~ /^(eq|==)$/ ) {
+ push @diag => $class->_is_diag( $got, $type, $expect );
+ }
+ elsif( $type =~ /^(ne|!=)$/ ) {
+ push @diag => $class->_isnt_diag( $got, $type );
+ }
+ else {
+ push @diag => $class->_cmp_diag( $got, $type, $expect );
+ }
+ }
+
+ return($test, @diag);
+}
+
+sub is_eq {
+ my($class, $got, $expect) = @_;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+ return ($test, $test ? () : $class->_is_diag($got, 'eq', $expect));
+ }
+
+ return $class->cmp_check($got, 'eq', $expect);
+}
+
+sub is_num {
+ my($class, $got, $expect) = @_;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+ return ($test, $test ? () : $class->_is_diag($got, '==', $expect));
+ }
+
+ return $class->cmp_check($got, '==', $expect);
+}
+
+sub isnt_eq {
+ my($class, $got, $dont_expect) = @_;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+ return ($test, $test ? () : $class->_isnt_diag($got, 'ne'));
+ }
+
+ return $class->cmp_check($got, 'ne', $dont_expect);
+}
+
+sub isnt_num {
+ my($class, $got, $dont_expect) = @_;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+ return ($test, $test ? () : $class->_isnt_diag($got, '!='));
+ }
+
+ return $class->cmp_check($got, '!=', $dont_expect);
+}
+
+sub regex_check {
+ my($class, $thing, $got_regex, $cmp) = @_;
+
+ my $regex = is_regex($got_regex);
+ return (0, " '$got_regex' doesn't look much like a regex to me.")
+ unless $regex;
+
+ my $ctx = context();
+ my ($p, $file, $line) = $ctx->call;
+
+ my $test;
+ my $mock = qq{#line $line "$file"\n};
+
+ my @warnings;
+ my ($success, $error) = try {
+ # No point in issuing an uninit warning, they'll see it in the diagnostics
+ no warnings 'uninitialized';
+ ## no critic (BuiltinFunctions::ProhibitStringyEval)
+ protect { eval $mock . q{$test = $thing =~ /$regex/ ? 1 : 0; 1} || die $@ };
+ };
+
+ return (0, "Exception: $error") unless $success;
+
+ my $negate = $cmp eq '!~';
+
+ $test = !$test if $negate;
+
+ unless($test) {
+ $thing = defined $thing ? "'$thing'" : 'undef';
+ my $match = $negate ? "matches" : "doesn't match";
+ my $diag = sprintf(qq{ \%s\n \%13s '\%s'\n}, $thing, $match, $got_regex);
+ return (0, $diag);
+ }
+
+ return (1);
+}
+
+sub can_check {
+ my ($us, $proto, $class, @methods) = @_;
+
+ my @diag;
+ for my $method (@methods) {
+ my $ok;
+ my ($success, $error) = try { $ok = $proto->can($method) };
+ if ($success) {
+ push @diag => " $class\->can('$method') failed" unless $ok;
+ }
+ else {
+ my $file = __FILE__;
+ $error =~ s/ at \Q$file\E line \d+//;
+ push @diag => " $class\->can('$method') failed with an exception:\n $error";
+ }
+ }
+
+ return (!@diag, @diag)
+}
+
+sub isa_check {
+ my($us, $thing, $class, $thing_name) = @_;
+
+ my ($whatami, $try_isa, $diag, $type);
+ if( !defined $thing ) {
+ $whatami = 'undef';
+ $$thing_name = "undef" unless defined $$thing_name;
+ $diag = defined $thing ? "$$thing_name isn't a '$class'" : "$$thing_name isn't defined";
+ }
+ elsif($type = blessed $thing) {
+ $whatami = 'object';
+ $try_isa = 1;
+ $$thing_name = "An object of class '$type'" unless defined $$thing_name;
+ $diag = "$$thing_name isn't a '$class'";
+ }
+ elsif($type = ref $thing) {
+ $whatami = 'reference';
+ $$thing_name = "A reference of type '$type'" unless defined $$thing_name;
+ $diag = "$$thing_name isn't a '$class'";
+ }
+ else {
+ $whatami = 'class';
+ $try_isa = $thing && $thing !~ m/^\d+$/;
+ $$thing_name = "The class (or class-like) '$thing'" unless defined $$thing_name;
+ $diag = "$$thing_name isn't a '$class'";
+ }
+
+ my $ok;
+ if ($try_isa) {
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ my ($success, $error) = try {
+ my $ctx = context();
+ my ($p, $f, $l) = $ctx->call;
+ eval qq{#line $l "$f"\n\$ok = \$thing\->isa(\$class); 1} || die $@;
+ };
+
+ die <<" WHOA" unless $success;
+WHOA! I tried to call ->isa on your $whatami and got some weird error.
+Here's the error.
+$error
+ WHOA
+ }
+ else {
+ # Special case for isa_ok( [], "ARRAY" ) and like
+ $ok = UNIVERSAL::isa($thing, $class);
+ }
+
+ return ($ok) if $ok;
+ return ($ok, " $diag\n");
+}
+
+sub new_check {
+ my($us, $class, $args, $object_name) = @_;
+
+ $args ||= [];
+
+ my $obj;
+ my($success, $error) = try {
+ my $ctx = context();
+ my ($p, $f, $l) = $ctx->call;
+ eval qq{#line $l "$f"\n\$obj = \$class\->new(\@\$args); 1} || die $@;
+ };
+ if($success) {
+ $object_name = "'$object_name'" if $object_name;
+ my ($ok, @diag) = $us->isa_check($obj, $class, \$object_name);
+ my $name = "$object_name isa '$class'";
+ return ($obj, $name, $ok, @diag);
+ }
+ else {
+ $class = 'undef' unless defined $class;
+ return (undef, "$class->new() died", 0, " Error was: $error");
+ }
+}
+
+sub explain {
+ my ($us, @args) = @_;
+ protect { require Data::Dumper };
+
+ return map {
+ ref $_
+ ? do {
+ my $dumper = Data::Dumper->new( [$_] );
+ $dumper->Indent(1)->Terse(1);
+ $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
+ $dumper->Dump;
+ }
+ : $_
+ } @args;
+}
+
+sub _diag_fmt {
+ my( $class, $type, $val ) = @_;
+
+ if( defined $$val ) {
+ if( $type eq 'eq' or $type eq 'ne' ) {
+ # quote and force string context
+ $$val = "'$$val'";
+ }
+ else {
+ # force numeric context
+ unoverload_num($val);
+ }
+ }
+ else {
+ $$val = 'undef';
+ }
+
+ return;
+}
+
+sub _is_diag {
+ my( $class, $got, $type, $expect ) = @_;
+
+ $class->_diag_fmt( $type, $_ ) for \$got, \$expect;
+
+ return <<"DIAGNOSTIC";
+ got: $got
+ expected: $expect
+DIAGNOSTIC
+}
+
+sub _isnt_diag {
+ my( $class, $got, $type ) = @_;
+
+ $class->_diag_fmt( $type, \$got );
+
+ return <<"DIAGNOSTIC";
+ got: $got
+ expected: anything else
+DIAGNOSTIC
+}
+
+
+sub _cmp_diag {
+ my( $class, $got, $type, $expect ) = @_;
+
+ $got = defined $got ? "'$got'" : 'undef';
+ $expect = defined $expect ? "'$expect'" : 'undef';
+
+ return <<"DIAGNOSTIC";
+ $got
+ $type
+ $expect
+DIAGNOSTIC
+}
+
+sub subtest {
+ my ($class, $name, $code, @args) = @_;
+
+ my $ctx = context();
+
+ $ctx->throw("subtest()'s second argument must be a code ref")
+ unless $code && 'CODE' eq reftype($code);
+
+ $ctx->child('push', $name);
+ $ctx->clear;
+ my $todo = $ctx->hide_todo;
+
+ my ($succ, $err) = try {
+ {
+ no warnings 'once';
+ local $Test::Builder::Level = 1;
+ $code->(@args);
+ }
+
+ $ctx->set;
+ my $stream = $ctx->stream;
+ $ctx->done_testing unless $stream->plan || $stream->ended;
+
+ require Test::Stream::ExitMagic;
+ {
+ local $? = 0;
+ Test::Stream::ExitMagic->new->do_magic($stream, $ctx->snapshot);
+ }
+ };
+
+ $ctx->set;
+ $ctx->restore_todo($todo);
+ # This sends the subtest event
+ my $st = $ctx->child('pop', $name);
+
+ unless ($succ) {
+ die $err unless blessed($err) && $err->isa('Test::Stream::Event');
+ $ctx->bail($err->reason) if $err->isa('Test::Stream::Event::Bail');
+ }
+
+ return $st->bool;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::More::Tools - Generic form of tools from Test::More.
+
+=head1 DESCRIPTION
+
+People used to call L<Test::More> tools within other testing tools. This mostly
+works, but it generates events for each call. This package gives you access to
+the implementations directly, without generating events for you. This allows
+you to create a composite tool without generating extra events.
+
+=head1 SYNOPSYS
+
+ use Test::More::Tools qw/tmt/;
+ use Test::Stream::Toolset qw/context/;
+
+ # This is how Test::More::is is implemented
+ sub my_is {
+ my ($got, $want, $name) = @_;
+
+ my $ctx = context;
+
+ my ($ok, @diag) = tmt->is_eq($got, $want);
+
+ $ctx->ok($ok, $name, \@diag);
+ }
+
+=head1 EXPORTS
+
+=over 4
+
+=item $pkg = tmt()
+
+Simply returns the string 'Test::More::Tools';
+
+=back
+
+=head1 CLASS METHODS
+
+Not all methods are listed. The ones that have been omitted are not intuitive,
+and probably should not be used at all.
+
+=over 4
+
+=item ($bool, @diag) = tmt->cmp_check($got, $op, $want)
+
+Check 2 values using the operator specified example: C<$got == $want>
+
+=item ($bool, @diag) = tmt->is_eq($got, $want)
+
+String compare.
+
+=item ($bool, @diag) = tmt->is_num($got, $want)
+
+Numeric compare.
+
+=item ($bool, @diag) = tmt->isnt_eq($got, $dont_want)
+
+String inequality compare.
+
+=item ($bool, @diag) = tmt->isnt_num($got, $dont_want)
+
+Numeric inequality compare.
+
+=item ($bool, @diag) = tmt->regex_check($got, $regex, $op)
+
+Regex compare. C<$op> may be C<=~> or C<!~>.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/MostlyLike.pm b/cpan/Test-Simple/lib/Test/MostlyLike.pm
new file mode 100644
index 0000000000..76c6c470d8
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/MostlyLike.pm
@@ -0,0 +1,292 @@
+package Test::MostlyLike;
+use strict;
+use warnings;
+
+use Test::Stream::Toolset;
+use Test::Stream::Exporter;
+default_exports qw/mostly_like/;
+Test::Stream::Exporter->cleanup;
+
+use Test::More::DeepCheck::Tolerant;
+
+sub mostly_like {
+ my ($got, $want, $name) = @_;
+
+ my $ctx = context();
+
+ unless( @_ == 2 or @_ == 3 ) {
+ my $msg = <<'WARNING';
+mostly_like() takes two or three args, you gave %d.
+This usually means you passed an array or hash instead
+of a reference to it
+WARNING
+ chop $msg; # clip off newline so carp() will put in line/file
+
+ $ctx->alert(sprintf $msg, scalar @_);
+
+ $ctx->ok(0, undef, ['incorrect number of args']);
+ return 0;
+ }
+
+ my ($ok, @diag) = Test::More::DeepCheck::Tolerant->check($got, $want);
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::MostlyLike - Relaxed checking of deep data structures.
+
+=head1 SYNOPSYS
+
+ my $got = [qw/foo bar baz/];
+
+ mostly_like(
+ $got,
+ ['foo', qr/a/],
+ "Deeply nested structure matches (mostly)"
+ );
+
+=head1 DESCRIPTION
+
+A tool based on C<is_deeply> from L<Test::More>. This tool produces nearly
+identical diagnostics. This tool gives you extra control by letting you check
+only the parts of the structure you care about, ignoring the rest.
+
+=head1 EXPORTS
+
+=over 4
+
+=item $bool = mostly_like($got, $expect, $name)
+
+Generates a single ok event with diagnostics to help you find any failures.
+
+Got should be the data structure you want to test. $expect should be a data
+structure representing what you expect to see. Unlike C<is_deeply> any keys in
+C<$got> that do not I<exist> in C<$expect> will be ignored.
+
+=back
+
+=head1 WHAT TO EXPECT
+
+When an a blessed object is encountered in the C<$got> structure, any fields
+listed in C<$expect> will be called as methods on the C<$got> object. See the
+object/direct element access section below for bypassing this.
+
+Any keys or attributes in C<$got> will be ignored unless the also I<exist> in C<$expect>
+
+=head1 IGNORING THINGS YOU DO NOT CARE ABOUT
+
+ my $got = { foo => 1, bar => 2 };
+ my $expect = { foo => 1 };
+
+ mostly_like($got, $expect, "Ignores 'bar'");
+
+If you want to check that a value is not set:
+
+ my $got = { foo => 1, bar => 2 };
+ my $expect = { foo => 1, bar => undef };
+
+ mostly_like($got, $expect, "Will fail since 'bar' has a value");
+
+=head2 EXACT MATCHES
+
+ my $got = 'foo';
+ my $expect = 'foo';
+ mostly_like($got, $expect, "Check a value directly");
+
+Also works for deeply nested structures
+
+ mostly_like(
+ [
+ {stuff => 'foo bar baz'},
+ ],
+ [
+ {stuff => 'foo bar baz'},
+ ],
+ "Check a value directly, nested"
+ );
+
+=head2 REGEX MATCHES
+
+ my $got = 'foo bar baz';
+ my $expect = qr/bar/;
+ mostly_like($got, $expect, 'Match');
+
+Works nested as well:
+
+ mostly_like(
+ [
+ {stuff => 'foo bar baz'},
+ ],
+ [
+ {stuff => qr/bar/},
+ ],
+ "Check a value directly, nested"
+ );
+
+=head2 ARRAY ELEMENT MATCHES
+
+ my $got = [qw/foo bar baz/];
+ my $exp = [qw/foo bar/];
+
+ mostly_like($got, $exp, "Ignores unspecified indexes");
+
+You can also just check specific indexes:
+
+ my $got = [qw/foo bar baz/];
+ my $exp = { ':1' => 'bar' };
+
+ mostly_like($got, $exp, "Only checks array index 1");
+
+When doing this the index must always be prefixed with ':'.
+
+=head2 HASH ELEMENT MATCHES
+
+ my $got = { foo => 1, bar => 2 };
+ my $exp = { foo => 1 };
+
+ mostly_like($got, $exp, "Only checks foo");
+
+=head2 OBJECT METHOD MATCHES
+
+=head3 UNALTERED
+
+ sub foo { $_[0]->{foo} }
+
+ my $got = bless {foo => 1}, __PACKAGE__;
+ my $exp = { foo => 1 };
+
+ mostly_like($got, $exp, 'Checks the return of $got->foo()');
+
+=head3 WRAPPED
+
+Sometimes methods return lists, in such cases you can wrap them in arrayrefs or
+hashrefs:
+
+ sub list { qw/foo bar baz/ }
+ sub dict { foo => 0, bar => 1, baz => 2 }
+
+ my $got = bless {}, __PACKAGE__;
+ my $exp = {
+ '[list]' => [ qw/foo bar baz/ ],
+ '[dict]' => { foo => 0, bar => 1, baz => 2 },
+ };
+ mostly_like($got, $exp, "Wrapped the method calls");
+
+=head3 DIRECT ELEMENT ACCESS
+
+Sometimes you want to ignore the methods and get the hash value directly.
+
+ sub foo { die "do not call me" }
+
+ my $got = bless { foo => 'secret' }, __PACKAGE__;
+ my $exp = { ':foo' => 'secret' };
+
+ mostly_like($got, $exp, "Did not call the fatal method");
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+=item Test::MostlyLike
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm
index 34736b2585..90a53fe91c 100644
--- a/cpan/Test-Simple/lib/Test/Simple.pm
+++ b/cpan/Test-Simple/lib/Test/Simple.pm
@@ -1,17 +1,65 @@
package Test::Simple;
-use 5.006;
+use 5.008001;
use strict;
+use warnings;
-our $VERSION = '1.001008';
+our $VERSION = '1.301001_063';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-use Test::Builder::Module 0.99;
-our @ISA = qw(Test::Builder::Module);
-our @EXPORT = qw(ok);
+use Test::Stream '-internal';
+use Test::Stream::Toolset;
+
+use Test::Stream::Exporter;
+default_exports qw/ok/;
+Test::Stream::Exporter->cleanup;
+
+sub before_import {
+ my $class = shift;
+ my ($importer, $list) = @_;
+
+ my $meta = init_tester($importer);
+ my $context = context(1);
+ my $idx = 0;
+ my $other = [];
+ while ($idx <= $#{$list}) {
+ my $item = $list->[$idx++];
+
+ if (defined $item and $item eq 'no_diag') {
+ Test::Stream->shared->set_no_diag(1);
+ }
+ elsif ($item eq 'tests') {
+ $context->plan($list->[$idx++]);
+ }
+ elsif ($item eq 'skip_all') {
+ $context->plan(0, 'SKIP', $list->[$idx++]);
+ }
+ elsif ($item eq 'no_plan') {
+ $context->plan(0, 'NO PLAN');
+ }
+ elsif ($item eq 'import') {
+ push @$other => @{$list->[$idx++]};
+ }
+ else {
+ $context->throw("Unknown option: $item");
+ }
+ }
+
+ @$list = @$other;
+
+ return;
+}
+
+sub ok ($;$) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
+ my $ctx = context();
+ return $ctx->ok(@_);
+ return $_[0] ? 1 : 0;
+}
-my $CLASS = __PACKAGE__;
+1;
+
+__END__
=head1 NAME
@@ -23,7 +71,6 @@ Test::Simple - Basic utilities for writing tests.
ok( $foo eq $bar, 'foo is bar' );
-
=head1 DESCRIPTION
** If you are unfamiliar with testing B<read L<Test::Tutorial> first!> **
@@ -74,12 +121,6 @@ All tests are run in scalar context. So this:
will do what you mean (fail if stuff is empty)
-=cut
-
-sub ok ($;$) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
- return $CLASS->builder->ok(@_);
-}
-
=back
Test::Simple will start by printing number of tests run in the form
@@ -194,12 +235,14 @@ programs and things will still work).
Look in L<Test::More>'s SEE ALSO for more testing modules.
-=head1 AUTHORS
+=encoding utf8
-Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
-E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
-=head1 MAINTAINERS
+=head1 MAINTAINER
=over 4
@@ -207,15 +250,87 @@ E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
=back
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
=head1 COPYRIGHT
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
-This program is free software; you can redistribute it and/or
+This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F<http://www.perl.com/perl/misc/Artistic.html>
-=cut
+=item Test::use::ok
-1;
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream.pm b/cpan/Test-Simple/lib/Test/Stream.pm
new file mode 100644
index 0000000000..ec470b4d83
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream.pm
@@ -0,0 +1,1083 @@
+package Test::Stream;
+use strict;
+use warnings;
+
+our $VERSION = '1.301001_063';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+use Test::Stream::Threads;
+use Test::Stream::IOSets;
+use Test::Stream::Util qw/try/;
+use Test::Stream::Carp qw/croak confess carp/;
+use Test::Stream::Meta qw/MODERN ENCODING init_tester/;
+use Encode();
+
+use Test::Stream::ArrayBase(
+ accessors => [qw{
+ no_ending no_diag no_header
+ pid tid
+ state
+ subtests subtest_todo
+ subtest_tap_instant
+ subtest_tap_delayed
+ mungers
+ listeners
+ follow_ups
+ bailed_out
+ exit_on_disruption
+ use_tap use_legacy _use_fork
+ use_numbers
+ io_sets
+ event_id
+ in_subthread
+ }],
+);
+
+use constant STATE_COUNT => 0;
+use constant STATE_FAILED => 1;
+use constant STATE_PLAN => 2;
+use constant STATE_PASSING => 3;
+use constant STATE_LEGACY => 4;
+use constant STATE_ENDED => 5;
+
+use constant OUT_STD => 0;
+use constant OUT_ERR => 1;
+use constant OUT_TODO => 2;
+
+use Test::Stream::Exporter;
+exports qw/
+ OUT_STD OUT_ERR OUT_TODO
+ STATE_COUNT STATE_FAILED STATE_PLAN STATE_PASSING STATE_LEGACY STATE_ENDED
+/;
+
+default_exports qw/ cull tap_encoding /;
+
+sub tap_encoding {
+ my ($encoding) = @_;
+
+ croak "encoding '$encoding' is not valid, or not available"
+ unless $encoding eq 'legacy' || Encode::find_encoding($encoding);
+
+ require Test::Stream::Context;
+ my $ctx = Test::Stream::Context::context();
+ $ctx->stream->io_sets->init_encoding($encoding);
+
+ my $meta = init_tester($ctx->package);
+ $meta->[ENCODING] = $encoding;
+}
+
+sub cull {
+ require Test::Stream::Context;
+ my $ctx = Test::Stream::Context::context();
+ $ctx->stream->fork_cull();
+}
+
+Test::Stream::Exporter->cleanup;
+sub before_import {
+ my $class = shift;
+ my ($importer, $list) = @_;
+
+ if (@$list && $list->[0] eq '-internal') {
+ shift @$list;
+ return;
+ }
+
+ my $meta = init_tester($importer);
+ $meta->[MODERN] = 1;
+
+ my $other = [];
+ my $idx = 0;
+ my $stream = $class->shared;
+
+ $stream->use_fork;
+
+ while ($idx <= $#{$list}) {
+ my $item = $list->[$idx++];
+ next unless $item;
+
+ if ($item eq 'subtest_tap') {
+ my $val = $list->[$idx++];
+ if (!$val || $val eq 'none') {
+ $stream->set_subtest_tap_instant(0);
+ $stream->set_subtest_tap_delayed(0);
+ }
+ elsif ($val eq 'instant') {
+ $stream->set_subtest_tap_instant(1);
+ $stream->set_subtest_tap_delayed(0);
+ }
+ elsif ($val eq 'delayed') {
+ $stream->set_subtest_tap_instant(0);
+ $stream->set_subtest_tap_delayed(1);
+ }
+ elsif ($val eq 'both') {
+ $stream->set_subtest_tap_instant(1);
+ $stream->set_subtest_tap_delayed(1);
+ }
+ else {
+ croak "'$val' is not a valid option for '$item'";
+ }
+ }
+ elsif ($item eq 'utf8') {
+ $stream->io_sets->init_encoding('utf8');
+ $meta->[ENCODING] = 'utf8';
+ }
+ elsif ($item eq 'encoding') {
+ my $encoding = $list->[$idx++];
+
+ croak "encoding '$encoding' is not valid, or not available"
+ unless Encode::find_encoding($encoding);
+
+ $stream->io_sets->init_encoding($encoding);
+ $meta->[ENCODING] = $encoding;
+ }
+ else {
+ push @$other => $item;
+ }
+ }
+
+ @$list = @$other;
+
+ return;
+}
+
+sub plan { $_[0]->[STATE]->[-1]->[STATE_PLAN] }
+sub count { $_[0]->[STATE]->[-1]->[STATE_COUNT] }
+sub failed { $_[0]->[STATE]->[-1]->[STATE_FAILED] }
+sub ended { $_[0]->[STATE]->[-1]->[STATE_ENDED] }
+sub legacy { $_[0]->[STATE]->[-1]->[STATE_LEGACY] }
+
+sub is_passing {
+ my $self = shift;
+
+ if (@_) {
+ ($self->[STATE]->[-1]->[STATE_PASSING]) = @_;
+ }
+
+ my $current = $self->[STATE]->[-1]->[STATE_PASSING];
+
+ my $plan = $self->[STATE]->[-1]->[STATE_PLAN];
+ return $current if $self->[STATE]->[-1]->[STATE_ENDED];
+ return $current unless $plan;
+ return $current unless $plan->max;
+ return $current if $plan->directive && $plan->directive eq 'NO PLAN';
+ return $current unless $self->[STATE]->[-1]->[STATE_COUNT] > $plan->max;
+
+ return $self->[STATE]->[-1]->[STATE_PASSING] = 0;
+}
+
+sub init {
+ my $self = shift;
+
+ $self->[PID] = $$;
+ $self->[TID] = get_tid();
+ $self->[STATE] = [[0, 0, undef, 1]];
+ $self->[USE_TAP] = 1;
+ $self->[USE_NUMBERS] = 1;
+ $self->[IO_SETS] = Test::Stream::IOSets->new;
+ $self->[EVENT_ID] = 1;
+ $self->[NO_ENDING] = 1;
+ $self->[SUBTESTS] = [];
+
+ $self->[SUBTEST_TAP_INSTANT] = 1;
+ $self->[SUBTEST_TAP_DELAYED] = 0;
+
+ $self->use_fork if USE_THREADS;
+
+ $self->[EXIT_ON_DISRUPTION] = 1;
+}
+
+{
+ my ($root, @stack, $magic);
+
+ END {
+ $root->fork_cull if $root && $root->_use_fork && $$ == $root->[PID];
+ $magic->do_magic($root) if $magic && $root && !$root->[NO_ENDING]
+ }
+
+ sub _stack { @stack }
+
+ sub shared {
+ my ($class) = @_;
+ return $stack[-1] if @stack;
+
+ @stack = ($root = $class->new(0));
+ $root->[NO_ENDING] = 0;
+
+ require Test::Stream::Context;
+ require Test::Stream::Event::Finish;
+ require Test::Stream::ExitMagic;
+ require Test::Stream::ExitMagic::Context;
+
+ $magic = Test::Stream::ExitMagic->new;
+
+ return $root;
+ }
+
+ sub clear {
+ $root->[NO_ENDING] = 1;
+ $root = undef;
+ $magic = undef;
+ @stack = ();
+ }
+
+ sub intercept_start {
+ my $class = shift;
+ my ($new) = @_;
+
+ my $old = $stack[-1];
+
+ unless($new) {
+ $new = $class->new();
+
+ $new->set_exit_on_disruption(0);
+ $new->set_use_tap(0);
+ $new->set_use_legacy(0);
+ }
+
+ push @stack => $new;
+
+ return ($new, $old);
+ }
+
+ sub intercept_stop {
+ my $class = shift;
+ my ($current) = @_;
+ croak "Stream stack inconsistency" unless $current == $stack[-1];
+ pop @stack;
+ }
+}
+
+sub intercept {
+ my $class = shift;
+ my ($code) = @_;
+
+ croak "The first argument to intercept must be a coderef"
+ unless $code && ref $code && ref $code eq 'CODE';
+
+ my ($new, $old) = $class->intercept_start();
+ my ($ok, $error) = try { $code->($new, $old) };
+ $class->intercept_stop($new);
+
+ die $error unless $ok;
+ return $ok;
+}
+
+sub listen {
+ my $self = shift;
+ for my $sub (@_) {
+ next unless $sub;
+
+ croak "listen only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->[LISTENERS]} => $sub;
+ }
+}
+
+sub munge {
+ my $self = shift;
+ for my $sub (@_) {
+ next unless $sub;
+
+ croak "munge only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->[MUNGERS]} => $sub;
+ }
+}
+
+sub follow_up {
+ my $self = shift;
+ for my $sub (@_) {
+ next unless $sub;
+
+ croak "follow_up only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->[FOLLOW_UPS]} => $sub;
+ }
+}
+
+sub use_fork {
+ require File::Temp;
+ require Storable;
+
+ $_[0]->[_USE_FORK] ||= File::Temp::tempdir(CLEANUP => 0);
+ confess "Could not get a temp dir" unless $_[0]->[_USE_FORK];
+ return 1;
+}
+
+sub fork_out {
+ my $self = shift;
+
+ my $tempdir = $self->[_USE_FORK];
+ confess "Fork support has not been turned on!" unless $tempdir;
+
+ my $tid = get_tid();
+
+ for my $event (@_) {
+ next unless $event;
+ next if $event->isa('Test::Stream::Event::Finish');
+
+ # First write the file, then rename it so that it is not read before it is ready.
+ my $name = $tempdir . "/$$-$tid-" . ($self->[EVENT_ID]++);
+ my ($ret, $err) = try { Storable::store($event, $name) };
+ # Temporary to debug an error on one cpan-testers box
+ unless ($ret) {
+ require Data::Dumper;
+ confess(Data::Dumper::Dumper({ error => $err, event => $event}));
+ }
+ rename($name, "$name.ready") || confess "Could not rename file '$name' -> '$name.ready'";
+ }
+}
+
+sub fork_cull {
+ my $self = shift;
+
+ confess "fork_cull() can only be called from the parent process!"
+ if $$ != $self->[PID];
+
+ confess "fork_cull() can only be called from the parent thread!"
+ if get_tid() != $self->[TID];
+
+ my $tempdir = $self->[_USE_FORK];
+ confess "Fork support has not been turned on!" unless $tempdir;
+
+ opendir(my $dh, $tempdir) || croak "could not open temp dir ($tempdir)!";
+
+ my @files = sort readdir($dh);
+ for my $file (@files) {
+ next if $file =~ m/^\.+$/;
+ next unless $file =~ m/\.ready$/;
+
+ # Untaint the path.
+ my $full = "$tempdir/$file";
+ ($full) = ($full =~ m/^(.*)$/gs);
+
+ my $obj = Storable::retrieve($full);
+ confess "Empty event object found '$full'" unless $obj;
+
+ if ($ENV{TEST_KEEP_TMP_DIR}) {
+ rename($full, "$full.complete")
+ || confess "Could not rename file '$full', '$full.complete'";
+ }
+ else {
+ unlink($full) || die "Could not unlink file: $file";
+ }
+
+ my $cache = $self->_update_state($self->[STATE]->[0], $obj);
+ $self->_process_event($obj, $cache);
+ $self->_finalize_event($obj, $cache);
+ }
+
+ closedir($dh);
+}
+
+sub done_testing {
+ my $self = shift;
+ my ($ctx, $num) = @_;
+ my $state = $self->[STATE]->[-1];
+
+ if (my $old = $state->[STATE_ENDED]) {
+ my ($p1, $f1, $l1) = $old->call;
+ $ctx->ok(0, "done_testing() was already called at $f1 line $l1");
+ return;
+ }
+
+ if ($self->[FOLLOW_UPS]) {
+ $_->($ctx) for @{$self->[FOLLOW_UPS]};
+ }
+
+ $state->[STATE_ENDED] = $ctx->snapshot;
+
+ my $ran = $state->[STATE_COUNT];
+ my $plan = $state->[STATE_PLAN] ? $state->[STATE_PLAN]->max : 0;
+
+ if (defined($num) && $plan && $num != $plan) {
+ $ctx->ok(0, "planned to run $plan but done_testing() expects $num");
+ return;
+ }
+
+ $ctx->plan($num || $plan || $ran) unless $state->[STATE_PLAN];
+
+ if ($plan && $plan != $ran) {
+ $state->[STATE_PASSING] = 0;
+ return;
+ }
+
+ if ($num && $num != $ran) {
+ $state->[STATE_PASSING] = 0;
+ return;
+ }
+
+ unless ($ran) {
+ $state->[STATE_PASSING] = 0;
+ return;
+ }
+}
+
+sub send {
+ my ($self, $e) = @_;
+
+ # Subtest state management
+ if ($e->isa('Test::Stream::Event::Child')) {
+ if ($e->action eq 'push') {
+ $e->context->note("Subtest: " . $e->name) if $self->[SUBTEST_TAP_INSTANT] && !$e->no_note;
+
+ push @{$self->[STATE]} => [0, 0, undef, 1];
+ push @{$self->[SUBTESTS]} => [];
+ push @{$self->[SUBTEST_TODO]} => $e->context->in_todo;
+
+ return $e;
+ }
+ else {
+ pop @{$self->[SUBTEST_TODO]};
+ my $events = pop @{$self->[SUBTESTS]} || confess "Unbalanced subtest stack (events)!";
+ my $state = pop @{$self->[STATE]} || confess "Unbalanced subtest stack (state)!";
+ confess "Child pop left the stream without a state!" unless @{$self->[STATE]};
+
+ $e = Test::Stream::Event::Subtest->new_from_pairs(
+ context => $e->context,
+ created => $e->created,
+ events => $events,
+ state => $state,
+ name => $e->name,
+ );
+ }
+ }
+
+ my $cache = $self->_update_state($self->[STATE]->[-1], $e);
+
+ # Subtests get dibbs on events
+ if (@{$self->[SUBTESTS]}) {
+ $e->context->set_diag_todo(1) if $self->[SUBTEST_TODO]->[-1];
+ $e->set_in_subtest(scalar @{$self->[SUBTESTS]});
+ push @{$self->[SUBTESTS]->[-1]} => $e;
+
+ $self->_render_tap($cache) if $self->[SUBTEST_TAP_INSTANT] && !$cache->{no_out};
+ }
+ elsif($self->[_USE_FORK] && ($$ != $self->[PID] || get_tid() != $self->[TID])) {
+ $self->fork_out($e);
+ }
+ else {
+ $self->_process_event($e, $cache);
+ }
+
+ $self->_finalize_event($e, $cache);
+
+ return $e;
+}
+
+sub _update_state {
+ my ($self, $state, $e) = @_;
+ my $cache = {tap_event => $e, state => $state};
+
+ if ($e->isa('Test::Stream::Event::Ok')) {
+ $cache->{do_tap} = 1;
+ $state->[STATE_COUNT]++;
+ if (!$e->bool) {
+ $state->[STATE_FAILED]++;
+ $state->[STATE_PASSING] = 0;
+ }
+ }
+ elsif (!$self->[NO_HEADER] && $e->isa('Test::Stream::Event::Finish')) {
+ if ($self->[FOLLOW_UPS]) {
+ $_->($e->context) for @{$self->[FOLLOW_UPS]};
+ }
+
+ $state->[STATE_ENDED] = $e->context->snapshot;
+
+ my $plan = $state->[STATE_PLAN];
+ if ($plan && $e->tests_run && $plan->directive eq 'NO PLAN') {
+ $plan->set_max($state->[STATE_COUNT]);
+ $plan->set_directive(undef);
+ $cache->{tap_event} = $plan;
+ $cache->{do_tap} = 1;
+ }
+ else {
+ $cache->{do_tap} = 0;
+ $cache->{no_out} = 1;
+ }
+ }
+ elsif ($self->[NO_DIAG] && $e->isa('Test::Stream::Event::Diag')) {
+ $cache->{no_out} = 1;
+ }
+ elsif ($e->isa('Test::Stream::Event::Plan')) {
+ $cache->{is_plan} = 1;
+
+ if($self->[NO_HEADER]) {
+ $cache->{no_out} = 1;
+ }
+ elsif(my $existing = $state->[STATE_PLAN]) {
+ my $directive = $existing ? $existing->directive : '';
+
+ if ($existing && (!$directive || $directive eq 'NO PLAN')) {
+ my ($p1, $f1, $l1) = $existing->context->call;
+ my ($p2, $f2, $l2) = $e->context->call;
+ die "Tried to plan twice!\n $f1 line $l1\n $f2 line $l2\n";
+ }
+ }
+
+ my $directive = $e->directive;
+ $cache->{no_out} = 1 if $directive && $directive eq 'NO PLAN';
+ }
+
+ push @{$state->[STATE_LEGACY]} => $e if $self->[USE_LEGACY];
+
+ $cache->{number} = $state->[STATE_COUNT];
+
+ return $cache;
+}
+
+sub _process_event {
+ my ($self, $e, $cache) = @_;
+
+ if ($self->[MUNGERS]) {
+ $_->($self, $e) for @{$self->[MUNGERS]};
+ }
+
+ $self->_render_tap($cache) unless $cache->{no_out};
+
+ if ($self->[LISTENERS]) {
+ $_->($self, $e) for @{$self->[LISTENERS]};
+ }
+}
+
+sub _render_tap {
+ my ($self, $cache) = @_;
+
+ return if $^C;
+ return unless $self->[USE_TAP];
+ my $e = $cache->{tap_event};
+ return unless $cache->{do_tap} || $e->can('to_tap');
+
+ my $num = $self->use_numbers ? $cache->{number} : undef;
+ confess "XXX" unless $e->can('to_tap');
+ my @sets = $e->to_tap($num, $self->[SUBTEST_TAP_DELAYED]);
+
+ my $in_subtest = $e->in_subtest || 0;
+ my $indent = ' ' x $in_subtest;
+
+ for my $set (@sets) {
+ my ($hid, $msg) = @$set;
+ next unless $msg;
+ my $enc = $e->encoding || confess "Could not find encoding!";
+ my $io = $self->[IO_SETS]->{$enc}->[$hid] || confess "Could not find IO $hid for $enc";
+
+ local($\, $", $,) = (undef, ' ', '');
+ $msg =~ s/^/$indent/mg if $in_subtest;
+ print $io $msg;
+ }
+}
+
+sub _finalize_event {
+ my ($self, $e, $cache) = @_;
+
+ if ($cache->{is_plan}) {
+ $cache->{state}->[STATE_PLAN] = $e;
+ return unless $e->directive;
+ return unless $e->directive eq 'SKIP';
+ die $e if $e->in_subtest || !$self->[EXIT_ON_DISRUPTION];
+ exit 0;
+ }
+ elsif (!$cache->{do_tap} && $e->isa('Test::Stream::Event::Bail')) {
+ $self->[BAILED_OUT] = $e;
+ $self->[NO_ENDING] = 1;
+ die $e if $e->in_subtest || !$self->[EXIT_ON_DISRUPTION];
+ exit 255;
+ }
+}
+
+sub _reset {
+ my $self = shift;
+
+ return unless $self->pid != $$ || $self->tid != get_tid();
+
+ $self->[PID] = $$;
+ $self->[TID] = get_tid();
+ if (USE_THREADS || $self->[_USE_FORK]) {
+ $self->[_USE_FORK] = undef;
+ $self->use_fork;
+ }
+ $self->[STATE] = [[0, 0, undef, 1]];
+}
+
+sub CLONE {
+ for my $stream (_stack()) {
+ next unless defined $stream->pid;
+ next unless defined $stream->tid;
+
+ next if $$ == $stream->pid && get_tid() == $stream->tid;
+
+ $stream->[IN_SUBTHREAD] = 1;
+ }
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ return if $self->in_subthread;
+
+ my $dir = $self->[_USE_FORK] || return;
+
+ return unless defined $self->pid;
+ return unless defined $self->tid;
+
+ return unless $$ == $self->pid;
+ return unless get_tid() == $self->tid;
+
+ if ($ENV{TEST_KEEP_TMP_DIR}) {
+ print STDERR "# Not removing temp dir: $dir\n";
+ return;
+ }
+
+ opendir(my $dh, $dir) || confess "Could not open temp dir! ($dir)";
+ while(my $file = readdir($dh)) {
+ next if $file =~ m/^\.+$/;
+ die "Unculled event! You ran tests in a child process, but never pulled them in!\n"
+ if $file !~ m/\.complete$/;
+ unlink("$dir/$file") || confess "Could not unlink file: '$dir/$file'";
+ }
+ closedir($dh);
+ rmdir($dir) || warn "Could not remove temp dir ($dir)";
+}
+
+sub STORABLE_freeze {
+ my ($self, $cloning) = @_;
+ return if $cloning;
+ return ($self);
+}
+
+sub STORABLE_thaw {
+ my ($self, $cloning, @vals) = @_;
+ return if $cloning;
+ return Test::Stream->shared;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream - A modern infrastructure for testing.
+
+=head1 SYNOPSYS
+
+ # Enables modern enhancements such as forking support and TAP encoding.
+ # Also turns off expensive legacy support.
+ use Test::Stream;
+ use Test::More;
+
+ # ... Tests ...
+
+ done_testing;
+
+=head1 FEATURES
+
+When you load Test::Stream inside your test file you activate forking support,
+and prevent Test::More from turning on some expensive legacy support. You will
+also get warnings if your code, or any other code you load uses deprecated or
+discouraged practices.
+
+=head1 IMPORT ARGUMENTS
+
+Any import argument not recognised will be treated as an export, if it is not a
+valid export an exception will be thrown.
+
+=over 4
+
+=item '-internal'
+
+This argument, I<when given first>, will prevent the import process from
+turning on enhanced features. This is mainly for internal use (thus the name)
+in order to access/load Test::Stream.
+
+=item subtest_tap => 'none'
+
+Do not show events within subtests, just the subtest result itself.
+
+=item subtest_tap => 'instant'
+
+Show events as they happen (this is how legacy Test::More worked). This is the
+default.
+
+=item subtest_tap => 'delayed'
+
+Show events within subtest AFTER the subtest event itself is complete.
+
+=item subtest_tap => 'both'
+
+Show events as they happen, then also display them after.
+
+=item 'utf8'
+
+Set the TAP encoding to utf8
+
+=item encoding => '...'
+
+Set the TAP encoding.
+
+=back
+
+=head1 EXPORTS
+
+=head2 DEFAULT EXPORTS
+
+=over 4
+
+=item tap_encoding( $ENCODING )
+
+Set the tap encoding from this point on.
+
+=item cull
+
+Bring in results from child processes/threads. This is automatically done
+whenever a context is obtained, but you may wish to do it on demand.
+
+=back
+
+=head2 CONSTANTS
+
+none of these are exported by default you must request them
+
+=over
+
+=item OUT_STD
+
+=item OUT_ERR
+
+=item OUT_TODO
+
+These are indexes of specific IO handles inside an IO set (each encoding has an
+IO set).
+
+=item STATE_COUNT
+
+=item STATE_FAILED
+
+=item STATE_PLAN
+
+=item STATE_PASSING
+
+=item STATE_LEGACY
+
+=item STATE_ENDED
+
+These are indexes into the STATE array present in the stream.
+
+=back
+
+=head1 THE STREAM STACK AND METHODS
+
+At any point there can be any number of streams. Most streams will be present
+in the stream stack. The stack is managed via a collection of class methods.
+You can always access the "current" or "central" stream using
+Test::Stream->shared. If you want your events to go where they are supposed to
+then you should always send them to the shared stream.
+
+It is important to note that any toogle, control, listener, munger, etc.
+applied to a stream will effect only that stream. Independant streams, streams
+down the stack, and streams added later will not get any settings from other
+stacks. Keep this in mind if you take it upon yourself to modify the stream
+stack.
+
+=head2 TOGGLES AND CONTROLS
+
+=over 4
+
+=item $stream->use_fork
+
+Turn on forking support (it cannot be turned off).
+
+=item $stream->set_subtest_tap_instant($bool)
+
+=item $bool = $stream->subtest_tap_instant
+
+Render subtest events as they happen.
+
+=item $stream->set_subtest_tap_delayed($bool)
+
+=item $bool = $stream->subtest_tap_delayed
+
+Render subtest events when printing the result of the subtest
+
+=item $stream->set_exit_on_disruption($bool)
+
+=item $bool = $stream->exit_on_disruption
+
+When true, skip_all and bailout will call exit. When false the bailout and
+skip_all events will be thrown as exceptions.
+
+=item $stream->set_use_tap($bool)
+
+=item $bool = $stream->use_tap
+
+Turn TAP rendering on or off.
+
+=item $stream->set_use_legacy($bool)
+
+=item $bool = $stream->use_legacy
+
+Turn legacy result storing on and off.
+
+=item $stream->set_use_numbers($bool)
+
+=item $bool = $stream->use_numbers
+
+Turn test numbers on and off.
+
+=back
+
+=head2 SENDING EVENTS
+
+ Test::Stream->shared->send($event)
+
+The C<send()> method is used to issue an event to the stream. This method will
+handle thread/fork sych, mungers, listeners, TAP output, etc.
+
+=head2 ALTERING EVENTS
+
+ Test::Stream->shared->munge(sub {
+ my ($stream, $event) = @_;
+
+ ... Modify the event object ...
+
+ # return is ignored.
+ });
+
+Mungers can never be removed once added. The return from a munger is ignored.
+Any changes you wish to make to the object must be done directly by altering
+it in place. The munger is called before the event is rendered as TAP, and
+AFTER the event has made any necessary state changes.
+
+=head2 LISTENING FOR EVENTS
+
+ Test::Stream->shared->listen(sub {
+ my ($stream, $event) = @_;
+
+ ... do whatever you want with the event ...
+
+ # return is ignored
+ });
+
+Listeners can never be removed once added. The return from a listener is
+ignored. Changing an event in a listener is not something you should ever do,
+though no protections are in place to prevent it (this may change!). The
+listeners are called AFTER the event has been rendered as TAP.
+
+=head2 POST-TEST BEHAVIORS
+
+ Test::Stream->shared->follow_up(sub {
+ my ($context) = @_;
+
+ ... do whatever you need to ...
+
+ # Return is ignored
+ });
+
+follow_up subs are called only once, when the stream recieves a finish event. There are 2 ways a finish event can occur:
+
+=over 4
+
+=item done_testing
+
+A finish event is generated when you call done_testing. The finish event occurs
+before the plan is output.
+
+=item EXIT MAGIC
+
+A finish event is generated when the Test::Stream END block is called, just
+before cleanup. This event will not happen if it was already geenerated by a
+call to done_testing.
+
+=back
+
+=head2 OTHER METHODS
+
+=over
+
+=item $stream->state
+
+Get the current state of the stream. The state is an array where specific
+indexes have specific meanings. These indexes are managed via constants.
+
+=item $stream->plan
+
+Get the plan event, if a plan has been issued.
+
+=item $stream->count
+
+Get the test count so far.
+
+=item $stream->failed
+
+Get the number of failed tests so far.
+
+=item $stream->ended
+
+Get the context in which the tests ended, if they have ended.
+
+=item $stream->legacy
+
+Used internally to store events for legacy support.
+
+=item $stream->is_passing
+
+Check if the test is passing its plan.
+
+=item $stream->done_testing($context, $max)
+
+Tell the stream we are done testing.
+
+=item $stream->fork_cull
+
+Gather events from other threads/processes.
+
+=back
+
+=head2 STACK METHODS AND INTERCEPTING EVENTS
+
+=over 4
+
+=item $stream = Test::Stream->shared
+
+Get the current shared stream. The shared stream is the stream at the top of
+the stack.
+
+=item Test::Stream->clear
+
+Completely remove the stream stack. It is very unlikely you will ever want to
+do this.
+
+=item ($new, $old) = Test::Stream->intercept_start($new)
+
+=item ($new, $old) = Test::Stream->intercept_start
+
+Push a new stream to the top of the stack. If you do not provide a stack a new
+one will be created for you. If you have one created for you it will have the
+following differences from a default stack:
+
+ $new->set_exit_on_disruption(0);
+ $new->set_use_tap(0);
+ $new->set_use_legacy(0);
+
+=item Test::Stream->intercept_stop($top)
+
+Pop the stack, you must pass in the instance you expect to be popped, there
+will be an exception if they do not match.
+
+=item Test::Stream->intercept(sub { ... })
+
+ Test::Stream->intercept(sub {
+ my ($new, $old) = @_;
+
+ ...
+ });
+
+Temporarily push a new stream to the top of the stack. The codeblock you pass
+in will be run. Once your codelbock returns the stack will be popped and
+restored to the previous state.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Architecture.pod b/cpan/Test-Simple/lib/Test/Stream/Architecture.pod
new file mode 100644
index 0000000000..620adcfd63
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Architecture.pod
@@ -0,0 +1,444 @@
+=head1 NAME
+
+Test::Stream::Architecture - Overview of how the Test-More dist works.
+
+=head1 DESCRIPTION
+
+This is the document that explains the architecture of Test::More and all the
+stuff driving it under the hood.
+
+=head1 KEY COMPONTENTS
+
+This is the list of primary components and their brief description, The most
+critical ones will have more details in later sections.
+
+=over 4
+
+=item Test::More
+
+=item Test::Simple
+
+These are the primary public interfaces for anyone who wishes to write tests.
+
+=item Test::More::Tools
+
+All of the tools Test::More provides have been relocated and refactored into
+Test::More::Tools in such a way as to make them generic and reusable. This
+means you can use them without firing off events, you can then fire off your
+own events compiled from multiple tools. In many cases this is what tool
+builders actually want, but instead they settle for bumping C<$Level> and
+calling is/like/ok and producing extra events.
+
+=item Test::Builder
+
+This B<used> to be the main under the hood module for anyone who wished to
+write a L<Test::More> compatible test library. It still works, and should be
+fully functional and backwards compatible. It is however discouraged as it is
+mostly a compatability wrapper.
+
+=item Test::Stream
+
+This is the B<new> heart and soul of the Test::* architecture. However it is
+not the primary interface. This module is responsible for collecting all events
+from all threads and processes, then forwarding them to TAP and any added
+listeners.
+
+=item Test::Stream::IOSets
+
+This module is used to manage the IO handles to which all TAP is sent.
+Test::Builder cloned STDERR and STDOUT, then applied various magic to them.
+This module provides that legacy support while also adding support for utf8 and
+other encodings. By default all TAP goes to the 'legacy' outputs, which mimick
+what Test::Builder has always done. The 'legacy' outputs are also what get
+altered if someone uses the Test::Builder->output interface.
+
+=item Test::Stream::Toolset
+
+This is the primary interface a test module author should use. It ties together
+some key functions you should use. It proved 3 critical functions:
+
+ is_tester($package)
+
+ init_tester($package)
+
+ my $ctx = context();
+
+=item Test::Stream::Context
+
+This is the primary interface as far as generating events goes. Every test
+function should grab a context, and use it to generate events.
+
+Once a context object is created (the normal way) it is remembered, and
+anything that requests a context object will obtain the same instance. However
+once the instance is destroyed (end of your test function) it is forgotten, the
+next test function to run will then obtain a new context instance.
+
+=item Test::Stream::Event
+
+=item Test::Stream::Event::Ok
+
+=item Test::Stream::Event::Diag
+
+=item Test::Stream::Event::Note
+
+=item Test::Stream::Event::*
+
+All events generated by Test::More and other test tools now boil down to a
+proper object. All events must use Test::Stream::Event as a base.
+
+=item Test::Stream::ArrayBase
+
+This is the L<Moose> of Test::Stream. It is responsible for generating
+accessors and similar work. Unlike moose and others it uses an arrayref as the
+underlying object. This design descision was made to improve performance.
+Performance was a real problem in some early alphas, the gains from the
+descision are huge.
+
+=item Test::Stream::Tester
+
+This is actually what spawned the ideas for the new Test::Stream work. This is
+a module that lets you validate your testing tools.
+
+=back
+
+=head1 THE STREAM OBJECT
+
+=over 4
+
+=item L<Test::Stream>
+
+=back
+
+=head2 HISTORY
+
+L<Test::Builder> is/was a singleton. The singleton model was chosen to solve
+the problem of synchronizing everything to a central location. Ultimately all
+results need to make their way to a central place that can assign them a
+number, and shove them through the correct output.
+
+The singleton model proved to be a major headache.
+
+Intercepting events typically meant replacing the singleton perminantly
+(Test::Tester) or for a limited scope. Another option people took
+(Test::Builder::Tester) was to simply replace the IO handles Test::Builder was
+tracking.
+
+Test::Builder did not provide any real mechanisms for altering events before
+processing them, or for intercepting them before they were turned into TAP. As
+a result many modules have monkeypatched Test::Builder, particularily the
+C<ok()> method.
+
+=head2 CURRENT DESIGN
+
+Test::Stream unfortunately must still act as a singleton (mostly). But this
+time the design was to put as little as possible into the singleton.
+
+=head3 RESPONSIBILITIES OF TEST::STREAM
+
+Test::Stream has 4 main jobs:
+
+=over 4
+
+=item Collect events from all threads and processes into 1 place
+
+ $stream->send($event);
+
+The send() method will ensure that the event gets to the right place, no matter
+what thread or process you are in. (Forking support must be turned on, it is
+off by default).
+
+B<Note:> This method is key to performance. This method and everything it calls
+must remain as lean and tight as possible.
+
+=item Provide a pre-output hook for altering events
+
+ $stream->munge(sub { my ($stream, $event) = @_; ... })
+
+This lets you modify events before they are turned into output. You cannot
+remove the event, nor can you add events. Mungers are additive, and proceessed
+in the order they are added.
+
+There is not currently any way to remove a munger.
+
+B<Note:> each munger is called in a loop in the C<send()> method, so keep it is
+fast and small as possible.
+
+=item Forward all events to listeners (including TAP output)
+
+ $stream->listen(sub { my ($stream, $event) = @_; .... })
+
+This lets you add a listener. All events that come to the stream object will be
+sent to all listeners.
+
+There is not currently any way to remove a listener.
+
+B<Note:> each listener is called in a loop in the C<send()> method, so keep it is
+fast and small as possible.
+
+=item Maintaining the legacy exit behavior from Test::Builder
+
+This is primarily setting $? to the number of tests that failed, up to 255, as
+well as providing other output such as missing a plan.
+
+=back
+
+=head3 SEMI-SINGLETON MODEL
+
+Test::Stream has a semi-singleton model. Instead of 1 singleton, it is a
+singleton stack. Anything that wants to send an event to the B<current> acting
+stream should send it to the stream returned by C<< Test::Stream->shared >>.
+Nothing should ever cache this result as the B<current> stream may change.
+
+This mechanism is primarily used for intercepting, and hiding, all events for a
+limited scope. L<Test::Stream::Tester> uses this to push a stream onto the stack so
+that you can generate events that do not go to the listeners or TAP. Once the
+stack is popped the previous stream is restored allowing you to generate real
+events.
+
+You can also create new Test::Stream objects at-will that are not present in
+the stack, this lets you create alternate streams for any purpose you want.
+
+=head1 THE CONTEXT OBJECT
+
+=over 4
+
+=item L<Test::Stream::Context>
+
+=back
+
+This module is responsbile for 2 things, knowing where to report errors, and
+making it easy to issue events.
+
+=head2 ERROR REPORTING
+
+To get the context you use the C<context()> function.
+
+ sub ok {
+ my $context = context();
+ ...
+ }
+
+ ok() # Errors are reported here.
+
+If there is a context already in play, that instance will be returned.
+Otherwise a new context will be returned. The context assumes that the stack
+level just above your call is where errors should be reported.
+
+You can optionally provide an integer as the only argument, in whcih case that
+number will be added to the C<caller()> call to find the correct frame for
+reporting. This will be completely ignored if there is already an active
+context.
+
+ sub ok {
+ my $context = context();
+ ...
+ }
+
+ sub my_ok {
+ my $context = context();
+ ok(...);
+ }
+
+ my_ok();
+
+In the example above c<my_ok()> generates a new context, then it calls C<ok()>,
+in this case both function will have the same context object, the one generated
+by my_ok. The result is that C<ok> will report errors to the correct place.
+
+=head3 IMPLEMENTEATION
+
+There is a variable C<$CURRENT> in C<Test::Stream::Context>, it is a lexical,
+so you can not touch it directly. When the C<context()> function is called, it
+first checks if $CURRENT is set, if so it returns that. If there is no current
+context it generates a new one.
+
+When a new context is generated, it is assigned to C<$CURRENT>, but then the
+reference is weakened. This means that once the returned copy falls out of
+scope, or is otherwise removed, C<$CURRENT> will vanish on its own. This means
+that so long as you hold on to your context object, anything you call will find
+it.
+
+B<The caveat> here is that if you descide to hold on to your context beyond
+your scope, you could sabatoge any future test functions. If you need to hold
+on to a context you need to call C<< $context->snapshot >>, and store the
+cloned object it returns. In general you should not need to do this, event
+objects all store the context, but do so using a snapshot.
+
+B<Note> I am open to changing this to remove the weak-reference magic and
+instead require someone to call C<< $context->release >> or similar when they
+are done with a context, but that seams more likely to result in rougue
+contexts... This method would also require its own form of reference counting..
+This descision will need to be made before we go stable.
+
+=head2 GENERATING EVENTS
+
+All event objects should use L<Test::Stream::Event> which will set them up as a
+proper event object, as well as add a method to L<Test::Stream::Context> which
+is a shortcut for generating that event type. As such you can fire off an event
+directly from your context object using the lowercase name of the event class.
+
+ my $ctx = context;
+ $ctx->ok(1, "pass");
+ $ctx->ok(0, "fail, ["This test failed, here is some diag ..."]);
+ $ctx->note("I am a teapot");
+
+All events take a context, and 2 other arguments as the first 3 arguments of
+their constructor, these shortcut methods handle those first 3 arguments for
+you, making life much easier.
+
+The other arguments are:
+
+=over 4
+
+=item created
+
+Should be an arrayref with caller information for where the event was generated.
+
+=item in_subtest
+
+True if the event belongs in a subtest, false otherwise.
+
+=back
+
+=head1 EVENT OBJECTS
+
+Here are the primary/public events. There are other events, but they are used
+internally.
+
+=over 4
+
+=item L<Test::Stream::Event>
+
+This is just a base-class, you do not use it directly.
+
+=item L<Test::Stream::Event::Diag>
+
+=item L<Test::Stream::Event::Note>
+
+=item L<Test::Stream::Event::Plan>
+
+=item L<Test::Stream::Event::Bail>
+
+These are faily simple and obvious event types.
+
+=item L<Test::Stream::Event::Ok>
+
+=item L<Test::Stream::Event::Subtest>
+
+B<Note:> C<Subtest> is a subclass of C<Ok>.
+
+Ok can contain diag objects related to that specific ok. Subtest contains all
+the events that went into the final subtest result.
+
+=back
+
+All events have a context in which they were created, which includes the file
+and line number where errors should be reported. They also have details on
+where/how they were generated. All other details are event specific.
+
+The subclass event should never be generated on its own. In fact, just use the
+subtest helpers provided by Test::More, or Test::Stream::Context. Under the
+hood a Child event is started which adds a subtest to a stack in Test::Stream,
+all events then get intercepted by that subtest. When the subtest is done you
+issue another Child event to close it out. Once closed a Subtest event will be
+generated for you and sent to the stream.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/ArrayBase.pm b/cpan/Test-Simple/lib/Test/Stream/ArrayBase.pm
new file mode 100644
index 0000000000..967a070d9a
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/ArrayBase.pm
@@ -0,0 +1,374 @@
+package Test::Stream::ArrayBase;
+use strict;
+use warnings;
+
+use Test::Stream::ArrayBase::Meta;
+use Test::Stream::Carp qw/confess croak/;
+use Scalar::Util qw/blessed reftype/;
+
+use Test::Stream::Exporter();
+
+sub import {
+ my $class = shift;
+ my $caller = caller;
+
+ $class->apply_to($caller, @_);
+}
+
+sub apply_to {
+ my $class = shift;
+ my ($caller, %args) = @_;
+
+ # Make the calling class an exporter.
+ my $exp_meta = Test::Stream::Exporter::Meta->new($caller);
+ Test::Stream::Exporter->export_to($caller, 'import')
+ unless $args{no_import};
+
+ my $ab_meta = Test::Stream::ArrayBase::Meta->new($caller);
+
+ my $ISA = do { no strict 'refs'; \@{"$caller\::ISA"} };
+
+ if ($args{base}) {
+ my ($base) = grep { $_->isa($class) } @$ISA;
+
+ croak "$caller is already a subclass of '$base', cannot subclass $args{base}"
+ if $base;
+
+ my $file = $args{base};
+ $file =~ s{::}{/}g;
+ $file .= ".pm";
+ require $file unless $INC{$file};
+
+ my $pmeta = Test::Stream::ArrayBase::Meta->get($args{base});
+ croak "Base class '$args{base}' is not a subclass of $class!"
+ unless $pmeta;
+
+ push @$ISA => $args{base};
+
+ $ab_meta->subclass($args{base});
+ }
+ elsif( !grep { $_->isa($class) } @$ISA) {
+ push @$ISA => $class;
+ $ab_meta->baseclass();
+ }
+
+ if ($args{accessors}) {
+ $ab_meta->add_accessor($_) for @{$args{accessors}};
+ }
+
+ 1;
+}
+
+sub new {
+ my $class = shift;
+ my $self = bless [@_], $class;
+ $self->init if $self->can('init');
+ return $self;
+}
+
+sub new_from_pairs {
+ my $class = shift;
+ my %params = @_;
+ my $self = bless [], $class;
+
+ while (my ($k, $v) = each %params) {
+ my $const = uc($k);
+ croak "$class has no accessor named '$k'" unless $class->can($const);
+ my $id = $class->$const;
+ $self->[$id] = $v;
+ }
+
+ $self->init if $self->can('init');
+ return $self;
+}
+
+sub to_hash {
+ my $array_obj = shift;
+ my $meta = Test::Stream::ArrayBase::Meta->get(blessed $array_obj);
+ my $fields = $meta->fields;
+ my %out;
+ for my $f (keys %$fields) {
+ my $i = $fields->{$f};
+ my $val = $array_obj->[$i];
+ my $ao = blessed($val) && $val->isa(__PACKAGE__);
+ $out{$f} = $ao ? $val->to_hash : $val;
+ }
+ return \%out;
+};
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::ArrayBase - Base class for classes that use an arrayref instead
+of a hash.
+
+=head1 SYNOPSYS
+
+A class:
+
+ package My::Class;
+ use strict;
+ use warnings;
+
+ use Test::Stream::ArrayBase accessors => [qw/foo bar baz/];
+
+ # Chance to initialize defaults
+ sub init {
+ my $self = shift; # No other args
+ $self->[FOO] ||= "foo";
+ $self->[BAR] ||= "bar";
+ $self->[BAZ] ||= "baz";
+ }
+
+ sub print {
+ print join ", " => map { $self->[$_] } FOO, BAR, BAZ;
+ }
+
+Subclass it
+
+ package My::Subclass;
+ use strict;
+ use warnings;
+ use Test::Stream::ArrayBase base => 'My::Class', # subclass
+ accessors => ['bat'];
+
+ sub init {
+ my $self = shift;
+
+ # We get the constants from the base class for free.
+ $self->[FOO] ||= 'SubFoo';
+ $self->[BAT] || = 'bat';
+
+ $self->SUPER::init();
+ }
+
+use it:
+
+ package main;
+ use strict;
+ use warnings;
+ use My::Class;
+
+ my $one = My::Class->new('MyFoo', 'MyBar');
+
+ # Accessors!
+ my $foo = $one->foo; # 'MyFoo'
+ my $bar = $one->bar; # 'MyBar'
+ my $baz = $one->baz; # Defaulted to: 'baz'
+
+ # Setters!
+ $one->set_foo('A Foo');
+ $one->set_bar('A Bar');
+ $one->set_baz('A Baz');
+
+ # It is an arrayref, you can do this!
+ my ($foo, $bar, $baz) = @$one;
+
+ # import constants:
+ use My::Class qw/FOO BAR BAZ/;
+
+ $one->[FOO] = 'xxx';
+
+=head1 DESCRIPTION
+
+This package is used to generate classes based on arrays instead of hashes. The
+primary motivation for this is performance (not premature!). Using this class
+will give you a C<new()> method, as well as generating accessors you request.
+Generated accessors will be getters, C<set_ACCESSOR> setters will also be
+generated for you. You also get constants for each accessor (all caps) which
+return the index into the array for that accessor. Single inheritence is also
+supported. For obvious reasons you cannot use multiple inheritence with an
+array based object.
+
+=head1 METHODS
+
+=head2 PROVIDED BY ARRAY BASE
+
+=over 4
+
+=item $it = $class->new(@VALUES)
+
+Create a new instance from a list of ordered values.
+
+=item $it = $class->new_from_pairs(%ACCESSOR_VAL_PAIRS)
+
+Create a new instance using key/value pairs.
+
+=item $hr = $it->to_hash()
+
+Get a hashref dump of the object. This will also dump any ArrayBase objects
+within to a hash, but only surface-depth ones.
+
+=item $it->import()
+
+This import method is actually provided by L<Test::Stream::Exporter> and allows
+you to import the constants generated for you.
+
+=back
+
+=head2 HOOKS
+
+=over 4
+
+=item $self->init()
+
+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.
+
+=back
+
+=head1 ACCESSORS
+
+To generate accessors you list them when using the module:
+
+ use Test::Stream::ArrayBase accessors => [qw/foo/];
+
+This will generate the following subs in your namespace:
+
+=over 4
+
+=item import()
+
+This will let you import the constants
+
+=item foo()
+
+Getter, used to get the value of the C<foo> field.
+
+=item set_foo()
+
+Setter, used to set the value of the C<foo> field.
+
+=item FOO()
+
+Constant, returs the field C<foo>'s index into the class arrayref. This
+function is also exported, but only when requested. Subclasses will also get
+this function as a constant, not simply a method, that means it is copied into
+the subclass namespace.
+
+=back
+
+=head1 SUBCLASSING
+
+You can subclass an existing ArrayBase class.
+
+ use Test::Stream::ArrayBase
+ base => 'Another::ArrayBase::Class',
+ accessors => [qw/foo bar baz/],
+
+Once an ArrayBase class is used as a subclass it is locked and no new fields
+can be added. All fields in any subclass will start at the next index after the
+last field of the parent. All constants from base classes are added to
+subclasses automatically.
+
+=head1 WHY?
+
+Switching to an arrayref base has resulted in significant performance boosts.
+
+When Test::Builder was initially refactored to support events, it was slow
+beyond reason. A large part of the slowdown was due to the use of proper
+methods instead of directly accessing elements. We also switched to using a LOT
+more objects that have methods.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/ArrayBase/Meta.pm b/cpan/Test-Simple/lib/Test/Stream/ArrayBase/Meta.pm
new file mode 100644
index 0000000000..0a1eca5369
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/ArrayBase/Meta.pm
@@ -0,0 +1,257 @@
+package Test::Stream::ArrayBase::Meta;
+use strict;
+use warnings;
+
+use Test::Stream::Carp qw/confess/;
+
+my %META;
+
+sub package { shift->{package} }
+sub parent { shift->{parent} }
+sub locked { shift->{locked} }
+sub fields {({ %{shift->{fields}} })}
+
+sub new {
+ my $class = shift;
+ my ($pkg) = @_;
+
+ $META{$pkg} ||= bless {
+ package => $pkg,
+ locked => 0,
+ }, $class;
+
+ return $META{$pkg};
+}
+
+sub get {
+ my $class = shift;
+ my ($pkg) = @_;
+
+ return $META{$pkg};
+}
+
+sub baseclass {
+ my $self = shift;
+ $self->{parent} = 'Test::Stream::ArrayBase';
+ $self->{index} = 0;
+ $self->{fields} = {};
+}
+
+sub subclass {
+ my $self = shift;
+ my ($parent) = @_;
+ confess "Already a subclass of $self->{parent}! Tried to sublcass $parent" if $self->{parent};
+
+ my $pmeta = $self->get($parent) || die "$parent is not an ArrayBase object!";
+ $pmeta->{locked} = 1;
+
+ $self->{parent} = $parent;
+ $self->{index} = $pmeta->{index};
+ $self->{fields} = $pmeta->fields; #Makes a copy
+
+ my $ex_meta = Test::Stream::Exporter::Meta->get($self->{package});
+
+ # Put parent constants into the subclass
+ for my $field (keys %{$self->{fields}}) {
+ my $const = uc $field;
+ no strict 'refs';
+ *{"$self->{package}\::$const"} = $parent->can($const) || confess "Could not find constant '$const'!";
+ $ex_meta->add($const);
+ }
+}
+
+sub add_accessor {
+ my $self = shift;
+ my ($name) = @_;
+
+ confess "Cannot add accessor, metadata is locked due to a subclass being initialized ($self->{parent}).\n"
+ if $self->{locked};
+
+ confess "field '$name' already defined!"
+ if exists $self->{fields}->{$name};
+
+ my $idx = $self->{index}++;
+ $self->{fields}->{$name} = $idx;
+
+ my $const = uc $name;
+ my $gname = lc $name;
+ my $sname = "set_$gname";
+
+ eval qq|
+ package $self->{package};
+ sub $gname { \$_[0]->[$idx] }
+ sub $sname { \$_[0]->[$idx] = \$_[1] }
+ sub $const() { $idx }
+ 1
+ | || confess $@;
+
+ # Add the constant as an optional export
+ my $ex_meta = Test::Stream::Exporter::Meta->get($self->{package});
+ $ex_meta->add($const);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::ArrayBase::Meta - Meta Object for ArrayBase objects.
+
+=head1 SYNOPSYS
+
+B<Note:> You probably do not want to directly use this object.
+
+ my $meta = Test::Stream::ArrayBase::Meta->new('Some::Class');
+ $meta->add_accessor('foo');
+
+=head1 DESCRIPTION
+
+This is the meta-object used by L<Test::Stream::ArrayBase>
+
+=head1 METHODS
+
+=over 4
+
+=item $meta = $class->new($package)
+
+Create a new meta object for the specified class. If one already exists that
+instance is returned.
+
+=item $meta = $class->get($package)
+
+Get the meta object for the specified class. Returns C<undef> if there is none
+initiated.
+
+=item $package = $meta->package
+
+Get the package the meta-object manages.
+
+=item $package = $meta->parent
+
+Get the parent package to the one being managed.
+
+=item $bool = $meta->locked
+
+True if the package has been locked. Locked means no new accessors can be
+added. A package is locked once something else subclasses it.
+
+=item $hr = $meta->fields
+
+Get a hashref defining the fields on the package. This is primarily for
+internal use, it is not very useful outside.
+
+=item $meta->baseclass
+
+Make the package inherit from ArrayBase directly.
+
+=item $meta->subclass($package)
+
+Set C<$package> as the base class of the managed package.
+
+=item $meta->add_accessor($name)
+
+Add an accessor to the package. Also defines the C<"set_$name"> method, and the
+C<uc($name)> constant.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Carp.pm b/cpan/Test-Simple/lib/Test/Stream/Carp.pm
new file mode 100644
index 0000000000..36a5ee8232
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Carp.pm
@@ -0,0 +1,142 @@
+package Test::Stream::Carp;
+use strict;
+use warnings;
+
+use Test::Stream::Exporter;
+
+export croak => sub { require Carp; goto &Carp::croak };
+export confess => sub { require Carp; goto &Carp::confess };
+export cluck => sub { require Carp; goto &Carp::cluck };
+export carp => sub { require Carp; goto &Carp::carp };
+
+Test::Stream::Exporter->cleanup;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Carp - Delayed Carp loader.
+
+=head1 DESCRIPTION
+
+Use this package instead of L<Carp> to avoid loading L<Carp> until absolutely
+necessary. This is used instead of Carp in L<Test::Stream> in order to avoid
+loading modules that packages you test may need to load themselves.
+
+=head1 SUPPORTED EXPORTS
+
+See L<Carp> for details on each of these functions.
+
+=over 4
+
+=item croak
+
+=item confess
+
+=item cluck
+
+=item carp
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Context.pm b/cpan/Test-Simple/lib/Test/Stream/Context.pm
new file mode 100644
index 0000000000..db36fc3497
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Context.pm
@@ -0,0 +1,635 @@
+package Test::Stream::Context;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed weaken/;
+
+use Test::Stream::Carp qw/confess/;
+
+use Test::Stream '-internal';
+use Test::Stream::Threads;
+use Test::Stream::Event();
+use Test::Stream::Util qw/try translate_filename/;
+use Test::Stream::Meta qw/init_tester is_tester/;
+
+use Test::Stream::ArrayBase(
+ accessors => [qw/frame stream encoding in_todo todo modern pid skip diag_todo provider monkeypatch_stash/],
+);
+
+use Test::Stream::Exporter qw/import export_to default_exports/;
+default_exports qw/context/;
+Test::Stream::Exporter->cleanup();
+
+{
+ no warnings 'once';
+ $Test::Builder::Level ||= 1;
+}
+
+my $CURRENT;
+
+sub init {
+ $_[0]->[FRAME] ||= _find_context(1); # +1 for call to init
+ $_[0]->[STREAM] ||= Test::Stream->shared;
+ $_[0]->[ENCODING] ||= 'legacy';
+ $_[0]->[PID] ||= $$;
+}
+
+sub peek { $CURRENT }
+sub clear { $CURRENT = undef }
+
+sub set {
+ $CURRENT = pop;
+ weaken($CURRENT);
+}
+
+my $WARNED;
+sub context {
+ my ($level, $stream) = @_;
+ # If the context has already been initialized we simply return it, we
+ # ignore any additional parameters as they no longer matter. The first
+ # thing to ask for a context wins, anything context aware that is called
+ # later MUST expect that it can get a context found by something down the
+ # stack.
+ if ($CURRENT) {
+ return $CURRENT unless $stream;
+ return $CURRENT if $stream == $CURRENT->[STREAM];
+ }
+
+ my $call = _find_context($level);
+ $call = _find_context_harder() unless $call;
+ my $pkg = $call->[0];
+
+ my $meta = is_tester($pkg) || _find_tester();
+
+ # Check if $TODO is set in the package, if not check if Test::Builder is
+ # loaded, and if so if it has Todo set. We check the element directly for
+ # performance.
+ my ($todo, $in_todo);
+ {
+ my $todo_pkg = $meta->[Test::Stream::Meta::PACKAGE];
+ no strict 'refs';
+ no warnings 'once';
+ if ($todo = $meta->[Test::Stream::Meta::TODO]) {
+ $in_todo = 1;
+ }
+ elsif ($todo = ${"$todo_pkg\::TODO"}) {
+ $in_todo = 1;
+ }
+ elsif ($Test::Builder::Test && defined $Test::Builder::Test->{Todo}) {
+ $todo = $Test::Builder::Test->{Todo};
+ $in_todo = 1;
+ }
+ else {
+ $in_todo = 0;
+ }
+ };
+
+ my ($ppkg, $pname);
+ if(my @provider = caller(1)) {
+ ($ppkg, $pname) = ($provider[3] =~ m/^(.*)::([^:]+)$/);
+ }
+
+ # Uh-Oh! someone has replaced the singleton, that means they probably want
+ # everything to go through them... We can't do a whole lot about that, but
+ # we will use the singletons stream which should catch most use-cases.
+ if ($Test::Builder::_ORIG_Test && $Test::Builder::_ORIG_Test != $Test::Builder::Test) {
+ $stream ||= $Test::Builder::Test->{stream};
+
+ my $warn = $meta->[Test::Stream::Meta::MODERN]
+ && !$WARNED++;
+
+ warn <<" EOT" if $warn;
+
+ *******************************************************************************
+ Something replaced the singleton \$Test::Builder::Test.
+
+ The Test::Builder singleton is no longer the central place for all test
+ events. Please look at Test::Stream, and Test::Stream->intercept() to
+ accomplish the type of thing that was once done with the singleton.
+
+ All attempts have been made to preserve compatability with older modules,
+ but if you experience broken behavior you may need to update your code. If
+ updating your code is not an option you will need to downgrade to a
+ Test::More prior to version 1.301001. Patches that restore compatability
+ without breaking necessary Test::Stream functionality will be gladly
+ accepted.
+ *******************************************************************************
+ EOT
+ }
+
+ $stream ||= $meta->[Test::Stream::Meta::STREAM] || Test::Stream->shared || confess "No Stream!?";
+ if ((USE_THREADS || $stream->_use_fork) && ($stream->pid == $$ && $stream->tid == get_tid())) {
+ $stream->fork_cull();
+ }
+
+ my $encoding = $meta->[Test::Stream::Meta::ENCODING] || 'legacy';
+ $call->[1] = translate_filename($encoding => $call->[1]) if $encoding ne 'legacy';
+
+ my $ctx = bless(
+ [
+ $call,
+ $stream,
+ $encoding,
+ $in_todo,
+ $todo,
+ $meta->[Test::Stream::Meta::MODERN] || 0,
+ $$,
+ undef,
+ $in_todo,
+ [$ppkg, $pname]
+ ],
+ __PACKAGE__
+ );
+
+ weaken($ctx->[STREAM]);
+
+ return $ctx if $CURRENT;
+
+ $CURRENT = $ctx;
+ weaken($CURRENT);
+ return $ctx;
+}
+
+sub _find_context {
+ my ($add) = @_;
+
+ $add ||= 0;
+ my $tb = $Test::Builder::Level - 1;
+
+ # 0 - call to find_context
+ # 1 - call to context/new
+ # 2 - call to tool
+ my $level = 2 + $add + $tb;
+ my ($package, $file, $line, $subname) = caller($level);
+
+ return unless $package;
+
+ while ($package eq 'Test::Builder') {
+ ($package, $file, $line, $subname) = caller(++$level);
+ }
+
+ return unless $package;
+
+ return [$package, $file, $line, $subname];
+}
+
+sub _find_context_harder {
+ my $level = 0;
+ my $fallback;
+ while(1) {
+ my ($pkg, $file, $line, $subname) = caller($level++);
+ $fallback ||= [$pkg, $file, $line, $subname] if $subname =~ m/::END$/;
+ next if $pkg =~ m/^Test::(Stream|Builder|More|Simple)(::.*)?$/;
+ return [$pkg, $file, $line, $subname];
+ }
+
+ return $fallback if $fallback;
+ return [ '<UNKNOWN>', '<UNKNOWN>', 0, '<UNKNOWN>' ];
+}
+
+sub _find_tester {
+ my $level = 2;
+ while(1) {
+ my $pkg = caller($level++);
+ last unless $pkg;
+ my $meta = is_tester($pkg) || next;
+ return $meta;
+ }
+
+ # find a .t file!
+ $level = 0;
+ while(1) {
+ my ($pkg, $file) = caller($level++);
+ last unless $pkg;
+ if ($file eq $0 && $file =~ m/\.t$/) {
+ return init_tester($pkg);
+ }
+ }
+
+ return init_tester('main');
+}
+
+sub alert {
+ my $self = shift;
+ my ($msg) = @_;
+
+ my @call = $self->call;
+
+ warn "$msg at $call[1] line $call[2].\n";
+}
+
+sub throw {
+ my $self = shift;
+ my ($msg) = @_;
+
+ my @call = $self->call;
+
+ $CURRENT = undef if $CURRENT = $self;
+
+ die "$msg at $call[1] line $call[2].\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 snapshot {
+ return bless [@{$_[0]}], blessed($_[0]);
+}
+
+sub send {
+ my $self = shift;
+ $self->[STREAM]->send(@_);
+}
+
+# Uhg.. support legacy monkeypatching
+# If this is still here in 2020 I will be a sad panda.
+{
+ sub ok {
+ return _ok(@_) unless $INC{'Test/Builder.pm'} && $Test::Builder::ORIG{ok} != \&Test::Builder::ok;
+ my $self = shift;
+ local $Test::Builder::CTX = $self;
+ my ($bool, $name, @stash) = @_;
+ push @{$self->[MONKEYPATCH_STASH]} => \@stash;
+ my $out = Test::Builder->new->ok($bool, $name);
+ return $out;
+ }
+
+ sub _unwind_ok {
+ my $self = shift;
+ my ($bool, $name) = @_;
+ my $stash = pop @{$self->[MONKEYPATCH_STASH]};
+ return $self->_ok($bool, $name, @$stash);
+ }
+
+ sub note {
+ return _note(@_) unless $INC{'Test/Builder.pm'} && $Test::Builder::ORIG{note} != \&Test::Builder::note;
+ local $Test::Builder::CTX = shift;
+ my $out = Test::Builder->new->note(@_);
+ return $out;
+ }
+
+ sub diag {
+ return _diag(@_) unless $INC{'Test/Builder.pm'} && $Test::Builder::ORIG{diag} != \&Test::Builder::diag;
+ local $Test::Builder::CTX = shift;
+ my $out = Test::Builder->new->diag(@_);
+ return $out;
+ }
+
+ sub plan {
+ return _plan(@_) unless $INC{'Test/Builder.pm'} && $Test::Builder::ORIG{plan} != \&Test::Builder::plan;
+ local $Test::Builder::CTX = shift;
+ my ($num, $dir, $arg) = @_;
+ $dir ||= 'tests';
+ $dir = 'skip_all' if $dir eq 'SKIP';
+ $dir = 'no_plan' if $dir eq 'NO PLAN';
+ my $out = Test::Builder->new->plan($dir, $num || $arg || ());
+ return $out;
+ }
+
+ sub done_testing {
+ return $_[0]->stream->done_testing(@_)
+ unless $INC{'Test/Builder.pm'} && $Test::Builder::ORIG{done_testing} != \&Test::Builder::done_testing;
+
+ local $Test::Builder::CTX = shift;
+ my $out = Test::Builder->new->done_testing(@_);
+ return $out;
+ }
+}
+
+my %EVENTS;
+sub events { \%EVENTS }
+
+sub register_event {
+ my $class = shift;
+ my ($pkg, $name) = @_;
+
+ my $real_name = lc($pkg);
+ $real_name =~ s/^.*:://g;
+
+ $name ||= $real_name;
+
+ confess "Method '$name' is already defined, event '$pkg' cannot get a context method!"
+ if $class->can($name);
+
+ $EVENTS{$real_name} = $pkg;
+
+ # Use a string eval so that we get a names sub instead of __ANON__
+ local ($@, $!);
+ eval qq|
+ sub $name {
+ my \$self = shift;
+ my \@call = caller(0);
+ my \$encoding = \$self->[ENCODING];
+ \$call[1] = translate_filename(\$encoding => \$call[1]) if \$encoding ne 'legacy';
+ my \$e = '$pkg'->new(\$self->snapshot, [\@call[0 .. 4]], 0, \@_);
+ return \$self->stream->send(\$e);
+ };
+ 1;
+ | || die $@;
+}
+
+sub hide_todo {
+ my $self = shift;
+ no strict 'refs';
+ no warnings 'once';
+
+ my $pkg = $self->[FRAME]->[0];
+ my $meta = is_tester($pkg);
+
+ my $found = {
+ TB => $Test::Builder::Test ? $Test::Builder::Test->{Todo} : undef,
+ META => $meta->[Test::Stream::Meta::TODO],
+ PKG => ${"$pkg\::TODO"},
+ };
+
+ $Test::Builder::Test->{Todo} = undef;
+ $meta->[Test::Stream::Meta::TODO] = undef;
+ ${"$pkg\::TODO"} = undef;
+
+ return $found;
+}
+
+sub restore_todo {
+ my $self = shift;
+ my ($found) = @_;
+ no strict 'refs';
+ no warnings 'once';
+
+ my $pkg = $self->[FRAME]->[0];
+ my $meta = is_tester($pkg);
+
+ $Test::Builder::Test->{Todo} = $found->{TB};
+ $meta->[Test::Stream::Meta::TODO] = $found->{META};
+ ${"$pkg\::TODO"} = $found->{PKG};
+
+ my $found2 = {
+ TB => $Test::Builder::Test ? $Test::Builder::Test->{Todo} : undef,
+ META => $meta->[Test::Stream::Meta::TODO] || undef,
+ PKG => ${"$pkg\::TODO"} || undef,
+ };
+
+ for my $k (qw/TB META PKG/) {
+ no warnings 'uninitialized';
+ next if "$found->{$k}" eq "$found2->{$k}";
+ die "Mismatch! $k:\t$found->{$k}\n\t$found2->{$k}\n"
+ }
+
+ return;
+}
+
+sub DESTROY { 1 }
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+ my $class = blessed($_[0]) || $_[0] || confess $AUTOLOAD;
+
+ my $name = $AUTOLOAD;
+ $name =~ s/^.*:://g;
+
+ my $module = 'Test/Stream/Event/' . ucfirst(lc($name)) . '.pm';
+ try { require $module };
+
+ my $sub = $class->can($name);
+ goto &$sub if $sub;
+
+ my ($pkg, $file, $line) = caller;
+
+ die qq{Can't locate object method "$name" via package "$class" at $file line $line.\n};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Context - Object to represent a testing context.
+
+=head1 DESCRIPTION
+
+In testing it is important to have context. It is not helpful to simply say a
+test failed, you want to know where it failed. This object is responsible for
+tracking the context of each test that is run. It makes it possible to get the
+file and line number where the failure occured .This object is also responsible
+for generating almost all the events you will encounter.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Context qw/context/;
+
+ sub my_tool {
+ my $ctx = context();
+
+ # Generate an event.
+ $ctx->ok(1, "Pass!");
+ }
+
+ 1;
+
+=head1 EXPORTS
+
+=over 4
+
+=item $ctx = context()
+
+This function is used to obtain a context. If there is already a context object
+in scope this will return it, otherwise it will return a new one.
+
+It is important that you never store a context object in a variable from a
+higher scope, a package variable, or an object attribute. The scope of a
+context matters a lot.
+
+If you want to store a context for later reference use the C<snapshot()> method
+to get a clone of it that is safe to store anywhere.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $ctx->alert($MESSAGE)
+
+This issues a warning at the calling context (filename and line number where
+errors should be reported).
+
+=item $ctx->throw($MESSAGE)
+
+This throws an exception at the calling context (filename and line number where
+errors should be reported).
+
+=item ($package, $file, $line, $subname) = $ctx->call()
+
+Get the caller details for the context. This is where errors should be
+reported.
+
+=item $pkg = $ctx->package
+
+Get the context package.
+
+=item $file = $ctx->file
+
+Get the context filename.
+
+=item $line = $ctx->line
+
+Get the context line number.
+
+=item $subname = $ctx->subname
+
+Get the context subroutine name.
+
+=item $ctx_copy = $ctx->snapshot
+
+Get a copy of the context object that is safe to store for later reference.
+
+=item $ctx->send($event)
+
+Send an event to the correct L<Test::Stream> object.
+
+=item $ctx = $class->peek
+
+Get the current context object, if there is one.
+
+=back
+
+=head2 DANGEROUS ONES
+
+=over 4
+
+=item $ctx->set
+
+=item $cclass->set($ctx)
+
+Set the context object as the current one, replacing any that might already be
+current.
+
+=item $class->clear
+
+Unset the current context.
+
+=item $ctx->register_event($package)
+
+=item $ctx->register_event($package, $name)
+
+Register a new event type, creating the shortcut method to generate it. If
+C<$name> is not provided it will be taken from the end of the package name, and
+will be lowercased.
+
+=item $hr = $ctx->events
+
+Get the hashref that holds C<< (name => $package) >> pairs. This is the actual
+ref used by the package, so please do not alter it.
+
+=item $stash = $ctx->hide_todo
+
+=item $ctx->restore_todo($stash)
+
+These are used to temporarily hide the TODO value in ALL places where it might
+be found. The returned C<$stash> must be used to restore it later.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event.pm b/cpan/Test-Simple/lib/Test/Stream/Event.pm
new file mode 100644
index 0000000000..0e35225589
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event.pm
@@ -0,0 +1,400 @@
+package Test::Stream::Event;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed/;
+use Test::Stream::Carp qw/confess/;
+
+use Test::Stream::ArrayBase(
+ accessors => [qw/context created in_subtest/],
+ no_import => 1,
+);
+
+sub import {
+ my $class = shift;
+
+ # Import should only when event is imported, subclasses do not use this
+ # import.
+ return if $class ne __PACKAGE__;
+
+ my $caller = caller;
+ my (%args) = @_;
+
+ my $ctx_meth = delete $args{ctx_method};
+
+ require Test::Stream::Context;
+ require Test::Stream;
+
+ # %args may override base
+ Test::Stream::ArrayBase->apply_to($caller, base => $class, %args);
+ Test::Stream::Context->register_event($caller, $ctx_meth);
+ Test::Stream::Exporter::export_to(
+ 'Test::Stream',
+ $caller,
+ qw/OUT_STD OUT_ERR OUT_TODO/,
+ );
+}
+
+sub init {
+ confess("No context provided!") unless $_[0]->[CONTEXT];
+}
+
+sub encoding { $_[0]->[CONTEXT]->encoding }
+
+sub extra_details {}
+
+sub summary {
+ my $self = shift;
+ my $type = blessed $self;
+ $type =~ s/^.*:://g;
+
+ my $ctx = $self->context;
+
+ my ($package, $file, $line) = $ctx->call;
+ my ($tool_pkg, $tool_name) = @{$ctx->provider};
+ $tool_name =~ s/^\Q$tool_pkg\E:://;
+
+ return (
+ type => lc($type),
+
+ $self->extra_details(),
+
+ package => $package || undef,
+ file => $file,
+ line => $line,
+
+ tool_package => $tool_pkg,
+ tool_name => $tool_name,
+
+ encoding => $ctx->encoding || undef,
+ in_todo => $ctx->in_todo || 0,
+ todo => $ctx->todo || '',
+ pid => $ctx->pid || 0,
+ skip => $ctx->skip || '',
+ );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event - Base class for events
+
+=head1 DESCRIPTION
+
+Base class for all event objects that get passed through
+L<Test::Stream>.
+
+=head1 SYNOPSYS
+
+ package Test::Stream::Event::MyEvent;
+ use strict;
+ use warnings;
+
+ # This will make our class an event subclass, add the specified accessors,
+ # inject a helper method into the context objects, and add constants for
+ # all our fields, and fields we inherit.
+ use Test::Stream::Event(
+ accessors => [qw/foo bar baz/],
+ ctx_method => 'my_event',
+ );
+
+ # Chance to initialize some defaults
+ sub init {
+ my $self = shift;
+ # no other args in @_
+
+ $self->SUPER::init();
+
+ $self->set_foo('xxx') unless defined $self->foo;
+
+ # Events are arrayrefs, all accessors have a constant defined with
+ # their index.
+ $self->[BAR] ||= "";
+
+ ...
+ }
+
+ # If your event produces TAP output it must define this method
+ sub to_tap {
+ my $self = shift;
+ return (
+ # Constants are defined at import, all are optional, and may appear
+ # any number of times.
+ [OUT_STD, $self->foo],
+ [OUT_ERR, $self->bar],
+ [OUT_STD, $self->baz],
+ );
+ }
+
+ # This is your hook to add details to the summary fields.
+ sub extra_details {
+ my $self = shift;
+
+ my @super_details = $self->SUPER::extra_details();
+
+ return (
+ @super_details,
+
+ foo => $self->foo || undef,
+ bar => $self->bar || '',
+ ...
+ );
+ }
+
+ 1;
+
+=head1 IMPORTING
+
+=head2 ARGUMENTS
+
+In addition to the arguments listed here, you may pass in any arguments
+accepted by L<Test::Stream::ArrayBase>.
+
+=over 4
+
+=item ctx_method => $NAME
+
+This specifies the name of the helper meth that will be injected into
+L<Test::Stream::Context> to help generate your events. If this is not specified
+it will use the lowercased last section of your package name.
+
+=item base => $BASE_CLASS
+
+This lets you specify an event class to subclass. B<THIS MUST BE AN EVENT
+CLASS>. If you do not specify anything here then C<Test::Stream::Event> will be
+used.
+
+=item accessors => \@FIELDS
+
+This lets you define any fields you wish to be present in your class. This is
+the only way to define storage for your event. Each field specified will get a
+read-only accessor with the same name as the field, as well as a setter
+C<set_FIELD()>. You will also get a constant that returns the index of the
+field in the classes arrayref. The constant is the name of the field in all
+upper-case.
+
+=back
+
+=head2 SUBCLASSING
+
+C<Test::Stream::Event> is added to your @INC for you, unless you specify an
+alternative base class, which must itself subclass C<Test::Stream::Event>.
+
+Events B<CAN NOT> use multiple inheritance in most cases. This is mainly
+because events are arrayrefs and not hashrefs. Each subclass must add fields as
+new indexes after the last index of the parent class.
+
+=head2 CONTEXT HELPER
+
+All events need some initial fields for construction. These fields include a
+context, and some other state from construction time. The context object will
+get helper methods for all events that fill in these fields for you. It is not
+advised to ever construct an event object yourself, you should I<always> use
+the context helper method.
+
+=head1 EVENTS ARE ARRAY REFERENCES
+
+Events are an arrayref. Events use L<Test::Stream::ArrayBase> under the hood to
+generate accessors, constants, and field indexes. The key thing to take away
+from this is that you cannot add attributes on the fly, you B<MUST> use
+L<Test::Stream::Event> and/or L<Test::Stream::ArrayBase> to add fields.
+
+If you need a place to store extar generic, and possibly unpredictable, data,
+you should add a field and assign a hashref to it, then use that hashref to
+store your mixed data.
+
+=head1 METHODS
+
+=over 4
+
+=item $ctx = $e->context
+
+Get a snapshot of the context as it was when this event was generated
+
+=item $call = $e->created
+
+Get the C<caller()> details from when the objects was created. This is usually
+the call to the tool that generated the event such as C<Test::More::ok()>.
+
+=item $bool = $e->in_subtest
+
+Check if the event was generated within a subtest.
+
+=item $encoding = $e->encoding
+
+Get the encoding that was in effect when the event was generated
+
+=item @details = $e->extra_details
+
+Get an ordered key/value pair list of summary fields for the event. Override
+this to add additional fields.
+
+=item @summary = $e->summary
+
+Get an ordered key/value pair list of summary fields for the event, including
+parent class fields. In general you should not override this as it has a useful
+(thought not depended upon) order.
+
+=back
+
+=head1 SUMMARY FIELDS
+
+These are the fields that will be present when calling
+C<< my %sum = $e->summary >>. Please note that the fields are returned as an
+order key+pair list, they can be directly assigned to a hash if desired, or
+they can be assigned to an array to preserver the order. The order is as it
+appears below, B<NOT> alphabetical.
+
+=over 4
+
+=item type
+
+The name of the event type, typically this is the lowercase form of the last
+part of the class name.
+
+=item package
+
+The package that generated this event.
+
+=item file
+
+The file in which the event was generated, and to which errors should be attributed.
+
+=item line
+
+The line number on which the event was generated, and to which errors should be
+attributed.
+
+=item tool_package
+
+The package that provided the tool that generated the event (example:
+Test::More)
+
+=item tool_name
+
+The name of the sub that produced the event (examples: C<ok()>, C<is()>).
+
+=item encoding
+
+The encoding that should be used when printing the TAP output from this event.
+
+=item in_todo
+
+True if the event was generated while TODO was in effect.
+
+=item todo
+
+The todo message if the event was generated with TODO in effect.
+
+=item pid
+
+The PID in which the event was generated.
+
+=item skip
+
+The skip message if the event was generated via skip.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Bail.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Bail.pm
new file mode 100644
index 0000000000..4164d55359
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Bail.pm
@@ -0,0 +1,182 @@
+package Test::Stream::Event::Bail;
+use strict;
+use warnings;
+
+use Test::Stream::Event(
+ accessors => [qw/reason quiet/],
+);
+
+sub to_tap {
+ my $self = shift;
+ return if $self->[QUIET];
+ return [
+ OUT_STD,
+ "Bail out! " . $self->reason . "\n",
+ ];
+}
+
+sub extra_details {
+ my $self = shift;
+ return (
+ $self->reason || '',
+ $self->quiet || 0,
+ );
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Bail - Bailout!
+
+=head1 DESCRIPTION
+
+The bailout event is generated when things go horribly wrong and you need to
+halt all testing in the current file.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Context qw/context/;
+ use Test::Stream::Event::Bail;
+
+ my $ctx = context();
+ my $event = $ctx->bail('Stuff is broken');
+
+=head1 METHODS
+
+Inherits from L<Test::Stream::Event>. Also defines:
+
+=over 4
+
+=item $reason = $e->reason
+
+The reason for the bailout.
+
+=item $bool = quiet
+
+Should the bailout be quiet?
+
+=back
+
+=head1 SUMMARY FIELDS
+
+These are the fields that will be present when calling
+C<< my %sum = $e->summary >>. Please note that the fields are returned as an
+order key+pair list, they can be directly assigned to a hash if desired, or
+they can be assigned to an array to preserver the order. The order is as it
+appears below, B<NOT> alphabetical.
+
+=over 4
+
+=item reason
+
+Reason for the bailout
+
+=item quiet
+
+Boolean, true if the bailout should be quiet.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Child.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Child.pm
new file mode 100644
index 0000000000..d6d380780e
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Child.pm
@@ -0,0 +1,144 @@
+package Test::Stream::Event::Child;
+use strict;
+use warnings;
+
+use Test::Stream::Carp qw/confess/;
+use Test::Stream::Event(
+ accessors => [qw/action name no_note/],
+);
+
+sub init {
+ confess "did not get an action" unless $_[0]->[ACTION];
+ confess "action must be either 'push' or 'pop', not '$_[0]->[ACTION]'"
+ unless $_[0]->[ACTION] =~ m/^(push|pop)$/;
+
+ $_[0]->[NAME] ||= "";
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Child - Child event type
+
+=head1 DESCRIPTION
+
+B<YOU PROBABLY DO NOT WANT TO USE THIS YOURSELF>
+
+Child events are used under the hood to start and stop subtests.
+L<Test::Stream::Event::Subtest> events are generated by child events.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Context qw/context/;
+ use Test::Stream::Event::Bail;
+
+ my $ctx = context();
+ $ctx->child( 'push', $NAME );
+
+ ... # Generate events
+
+ # Generates a subtest event
+ $ctx->child( 'pop', $NAME );
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Diag.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Diag.pm
new file mode 100644
index 0000000000..696c70d541
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Diag.pm
@@ -0,0 +1,198 @@
+package Test::Stream::Event::Diag;
+use strict;
+use warnings;
+
+use Test::Stream::Event(
+ accessors => [qw/message linked/],
+ ctx_method => '_diag',
+);
+
+use Test::Stream::Util qw/try/;
+use Scalar::Util qw/weaken/;
+use Test::Stream::Carp qw/confess/;
+
+sub init {
+ $_[0]->[MESSAGE] = 'undef' unless defined $_[0]->[MESSAGE];
+ weaken($_[0]->[LINKED]) if $_[0]->[LINKED];
+}
+
+sub link {
+ my $self = shift;
+ my ($to) = @_;
+ confess "Already linked!" if $self->[LINKED];
+ $self->[LINKED] = $to;
+ weaken($self->[LINKED]);
+}
+
+sub to_tap {
+ my $self = shift;
+
+ chomp(my $msg = $self->[MESSAGE]);
+
+ $msg = "# $msg" unless $msg =~ m/^\n/;
+ $msg =~ s/\n/\n# /g;
+
+ return [
+ ($self->[CONTEXT]->diag_todo ? OUT_TODO : OUT_ERR),
+ "$msg\n",
+ ];
+}
+
+sub extra_details {
+ my $self = shift;
+ return ( message => $self->message || '' );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Diag - Diag event type
+
+=encoding utf8
+
+=head1 DESCRIPTION
+
+Diagnostics messages, typically rendered to STDERR.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Context qw/context/;
+ use Test::Stream::Event::Diag;
+
+ my $ctx = context();
+ my $event = $ctx->diag($message);
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $diag->message
+
+The message for the diag.
+
+=item $diag->linked
+
+The Ok event the diag is linked to, if it is.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $diag->link($ok);
+
+Link the diag to an OK event.
+
+=back
+
+=head1 SUMMARY FIELDS
+
+=over 4
+
+=item message
+
+The message from the diag.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Finish.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Finish.pm
new file mode 100644
index 0000000000..2f181a9ee8
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Finish.pm
@@ -0,0 +1,127 @@
+package Test::Stream::Event::Finish;
+use strict;
+use warnings;
+
+use Test::Stream::Event(
+ accessors => [qw/tests_run tests_failed/],
+);
+
+sub extra_details {
+ my $self = shift;
+ return (
+ tests_run => $self->tests_run || 0,
+ tests_failed => $self->tests_failed || 0,
+ );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Finish - The finish event type
+
+=head1 DESCRIPTION
+
+Sent after testing is finished.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Note.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Note.pm
new file mode 100644
index 0000000000..91185f098b
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Note.pm
@@ -0,0 +1,169 @@
+package Test::Stream::Event::Note;
+use strict;
+use warnings;
+
+use Test::Stream::Event(
+ accessors => [qw/message/],
+ ctx_method => '_note',
+);
+
+use Test::Stream::Carp qw/confess/;
+
+sub init {
+ $_[0]->[MESSAGE] = 'undef' unless defined $_[0]->[MESSAGE];
+}
+
+sub to_tap {
+ my $self = shift;
+
+ chomp(my $msg = $self->[MESSAGE]);
+ $msg = "# $msg" unless $msg =~ m/^\n/;
+ $msg =~ s/\n/\n# /g;
+
+ return [OUT_STD, "$msg\n"];
+}
+
+sub extra_details {
+ my $self = shift;
+ return ( message => $self->message || '' );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Note - Note event type
+
+=encoding utf8
+
+=head1 DESCRIPTION
+
+Notes, typically rendered to STDOUT.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Context qw/context/;
+ use Test::Stream::Event::Note;
+
+ my $ctx = context();
+ my $event = $ctx->Note($message);
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $note->message
+
+The message for the note.
+
+=back
+
+=head1 SUMMARY FIELDS
+
+=over 4
+
+=item message
+
+The message from the note.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Ok.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Ok.pm
new file mode 100644
index 0000000000..9b1be21aa5
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Ok.pm
@@ -0,0 +1,386 @@
+package Test::Stream::Event::Ok;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed/;
+use Test::Stream::Util qw/unoverload_str/;
+use Test::Stream::Carp qw/confess/;
+
+use Test::Stream::Event(
+ accessors => [qw/real_bool name diag bool level/],
+ ctx_method => '_ok',
+);
+
+sub skip { $_[0]->[CONTEXT]->skip }
+sub todo { $_[0]->[CONTEXT]->todo }
+
+sub init {
+ my $self = shift;
+
+ # Do not store objects here, only true/false/undef
+ if ($self->[REAL_BOOL]) {
+ $self->[REAL_BOOL] = 1;
+ }
+ elsif(defined $self->[REAL_BOOL]) {
+ $self->[REAL_BOOL] = 0;
+ }
+ $self->[LEVEL] = $Test::Builder::Level;
+
+ my $ctx = $self->[CONTEXT];
+ my $rb = $self->[REAL_BOOL];
+ my $todo = $ctx->in_todo;
+ my $skip = defined $ctx->skip;
+ my $b = $rb || $todo || $skip || 0;
+ my $diag = delete $self->[DIAG];
+ my $name = $self->[NAME];
+
+ $self->[BOOL] = $b ? 1 : 0;
+
+ unless ($rb || ($todo && $skip)) {
+ my $msg = $todo ? "Failed (TODO)" : "Failed";
+ my $prefix = $ENV{HARNESS_ACTIVE} ? "\n" : "";
+
+ my ($pkg, $file, $line) = $ctx->call;
+
+ if (defined $name) {
+ $msg = qq[$prefix $msg test '$name'\n at $file line $line.];
+ }
+ else {
+ $msg = qq[$prefix $msg test at $file line $line.];
+ }
+
+ $self->add_diag($msg);
+ }
+
+ $self->add_diag(" You named your test '$name'. You shouldn't use numbers for your test names.\n Very confusing.")
+ if $name && $name =~ m/^[\d\s]+$/;
+
+ $self->add_diag(@$diag) if $diag && @$diag;
+}
+
+sub to_tap {
+ my $self = shift;
+ my ($num) = @_;
+
+ my $name = $self->[NAME];
+ my $context = $self->[CONTEXT];
+ my $skip = $context->skip;
+ my $todo = $context->todo;
+
+ my @out;
+ push @out => "not" unless $self->[REAL_BOOL];
+ push @out => "ok";
+ push @out => $num if defined $num;
+
+ unoverload_str \$name if defined $name;
+
+ if ($name) {
+ $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
+ push @out => ("-", $name);
+ }
+
+ if (defined $skip && defined $todo) {
+ push @out => "# TODO & SKIP";
+ push @out => $todo if length $todo;
+ }
+ elsif ($context->in_todo) {
+ push @out => "# TODO";
+ push @out => $todo if length $todo;
+ }
+ elsif (defined $skip) {
+ push @out => "# skip";
+ push @out => $skip if length $skip;
+ }
+
+ my $out = join " " => @out;
+ $out =~ s/\n/\n# /g;
+
+ return [OUT_STD, "$out\n"] unless $self->[DIAG];
+
+ return (
+ [OUT_STD, "$out\n"],
+ map {$_->to_tap($num)} @{$self->[DIAG]},
+ );
+}
+
+sub add_diag {
+ my $self = shift;
+
+ my $context = $self->[CONTEXT];
+ my $created = $self->[CREATED];
+
+ for my $item (@_) {
+ next unless $item;
+
+ if (ref $item) {
+ confess("Only diag objects can be linked to events.")
+ unless blessed($item) && $item->isa('Test::Stream::Event::Diag');
+
+ $item->link($self);
+ }
+ else {
+ $item = Test::Stream::Event::Diag->new($context, $created, $self->[IN_SUBTEST], $item, $self);
+ }
+
+ push @{$self->[DIAG]} => $item;
+ }
+}
+
+{
+ # Yes, we do want to override the imported one.
+ no warnings 'redefine';
+ sub clear_diag {
+ my $self = shift;
+ return unless $self->[DIAG];
+ my $out = $self->[DIAG];
+ $self->[DIAG] = undef;
+ $_->set_linked(undef) for @$out;
+ return $out;
+ }
+}
+
+sub to_legacy {
+ my $self = shift;
+
+ my $result = {};
+ $result->{ok} = $self->bool ? 1 : 0;
+ $result->{actual_ok} = $self->real_bool;
+ $result->{name} = $self->name;
+
+ my $ctx = $self->context;
+
+ if($self->skip && ($ctx->in_todo || $ctx->todo)) {
+ $result->{type} = 'todo_skip',
+ $result->{reason} = $ctx->skip || $ctx->todo;
+ }
+ elsif($ctx->in_todo || $ctx->todo) {
+ $result->{reason} = $ctx->todo;
+ $result->{type} = 'todo';
+ }
+ elsif($ctx->skip) {
+ $result->{reason} = $ctx->skip;
+ $result->{type} = 'skip';
+ }
+ else {
+ $result->{reason} = '';
+ $result->{type} = '';
+ }
+
+ if ($result->{reason} eq 'incrementing test number') {
+ $result->{type} = 'unknown';
+ }
+
+ return $result;
+}
+
+sub extra_details {
+ my $self = shift;
+
+ require Test::Stream::Tester::Events;
+
+ my $diag = join "\n", map {
+ my $msg = $_->message;
+ chomp($msg);
+ split /[\n\r]+/, $msg;
+ } @{$self->diag || []};
+
+ return (
+ diag => $diag || '',
+ bool => $self->bool || 0,
+ name => $self->name || undef,
+ real_bool => $self->real_bool || 0
+ );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Ok - Ok event type
+
+=encoding utf8
+
+=head1 DESCRIPTION
+
+Ok events are generated whenever you run a test that produces a result.
+Examples are C<ok()>, and C<is()>.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Context qw/context/;
+ use Test::Stream::Event::Ok;
+
+ my $ctx = context();
+ my $event = $ctx->ok($bool, $name, \@diag);
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $rb = $e->real_bool
+
+This is the true/false value of the test after TODO, SKIP, and similar
+modifiers are taken into account.
+
+=item $name = $e->name
+
+Name of the test.
+
+=item $diag = $e->diag
+
+An arrayref with all the L<Test::Stream::Event::Diag> events reduced down to
+just the messages. Some coaxing has beeen done to combine all the messages into
+a single string.
+
+=item $b = $e->bool
+
+The original true/false value of whatever was passed into the event (but
+reduced down to 1 or 0).
+
+=item $l = $e->level
+
+For legacy L<Test::Builder> support. Do not use this, it can go away, or change
+behavior at any time.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $le = $e->to_legacy
+
+Returns a hashref that matches some legacy details about ok's. You should
+probably not use this for anything new.
+
+=item $e->add_diag($diag_event, "diag message" ...)
+
+Add a diag to the event. The diag may be a diag event, or a simple string.
+
+=item $diag = $e->clear_diag
+
+Remove all diag events, then return them in an arrayref.
+
+=back
+
+=head1 SUMMARY FIELDS
+
+=over 4
+
+=item diag
+
+A single string with all the messages from the diags linked to the event.
+
+=item bool
+
+True/False passed into the test.
+
+=item name
+
+Name of the test.
+
+=item real_bool
+
+True/False value accounting for TODO and SKIP.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Plan.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Plan.pm
new file mode 100644
index 0000000000..84be2a040b
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Plan.pm
@@ -0,0 +1,219 @@
+package Test::Stream::Event::Plan;
+use strict;
+use warnings;
+
+use Test::Stream::Event(
+ accessors => [qw/max directive reason/],
+ ctx_method => '_plan',
+);
+
+use Test::Stream::Carp qw/confess/;
+
+my %ALLOWED = (
+ 'SKIP' => 1,
+ 'NO PLAN' => 1,
+);
+
+sub init {
+ if ($_[0]->[DIRECTIVE]) {
+ $_[0]->[DIRECTIVE] = 'SKIP' if $_[0]->[DIRECTIVE] eq 'skip_all';
+ $_[0]->[DIRECTIVE] = 'NO PLAN' if $_[0]->[DIRECTIVE] eq 'no_plan';
+
+ confess "'" . $_[0]->[DIRECTIVE] . "' is not a valid plan directive"
+ unless $ALLOWED{$_[0]->[DIRECTIVE]};
+ }
+ else {
+ $_[0]->[DIRECTIVE] = '';
+ confess "Cannot have a reason without a directive!"
+ if defined $_[0]->[REASON];
+
+ confess "No number of tests specified"
+ unless defined $_[0]->[MAX];
+
+
+ }
+}
+
+sub to_tap {
+ my $self = shift;
+
+ my $max = $self->[MAX];
+ my $directive = $self->[DIRECTIVE];
+ my $reason = $self->[REASON];
+
+ return if $directive && $directive eq 'NO PLAN';
+
+ my $plan = "1..$max";
+ if ($directive) {
+ $plan .= " # $directive";
+ $plan .= " $reason" if defined $reason;
+ }
+
+ return [OUT_STD, "$plan\n"];
+}
+
+sub extra_details {
+ my $self = shift;
+ return (
+ max => $self->max || 0,
+ directive => $self->directive || undef,
+ reason => $self->reason || undef
+ );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Plan - The event of a plan
+
+=encoding utf8
+
+=head1 DESCRIPTION
+
+Plan events are fired off whenever a plan is declared, done testing is called,
+or a subtext completes.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Context qw/context/;
+ use Test::Stream::Event::Plan;
+
+ my $ctx = context();
+ my $event = $ctx->plan($max, $directive, $reason);
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $num = $plan->max
+
+Get the number of expected tests
+
+=item $dir = $plan->directive
+
+Get the directive (such as TODO, skip_all, or no_plan).
+
+=item $reason = $plan->reason
+
+Get the reason for the directive.
+
+=back
+
+=head1 SUMMARY FIELDS
+
+=over 4
+
+=item max
+
+Number of expected tests.
+
+=item directive
+
+Directive.
+
+=item reason
+
+Reason for directive.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Event/Subtest.pm b/cpan/Test-Simple/lib/Test/Stream/Event/Subtest.pm
new file mode 100644
index 0000000000..57d1cbf1a5
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Event/Subtest.pm
@@ -0,0 +1,275 @@
+package Test::Stream::Event::Subtest;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed/;
+use Test::Stream::Carp qw/confess/;
+use Test::Stream qw/-internal STATE_PASSING STATE_COUNT STATE_FAILED STATE_PLAN/;
+
+use Test::Stream::Event(
+ base => 'Test::Stream::Event::Ok',
+ accessors => [qw/state events exception/],
+);
+
+sub init {
+ my $self = shift;
+
+ $self->[REAL_BOOL] = $self->[STATE]->[STATE_PASSING] && $self->[STATE]->[STATE_COUNT];
+ $self->[EVENTS] ||= [];
+
+ if (my $le = $self->[EVENTS]->[-1]) {
+ my $is_skip = $le->isa('Test::Stream::Event::Plan');
+ $is_skip &&= $le->directive;
+ $is_skip &&= $le->directive eq 'SKIP';
+
+ if ($is_skip) {
+ my $skip = $le->reason || "skip all";
+ # Should be a snapshot now:
+ $self->[CONTEXT]->set_skip($skip);
+ $self->[REAL_BOOL] = 1;
+ }
+
+ $self->[EXCEPTION] = $le if $is_skip || $le->isa('Test::Stream::Event::Bail');
+ }
+
+ push @{$self->[DIAG]} => ' No tests run for subtest.'
+ unless $self->[EXCEPTION] || $self->[STATE]->[STATE_COUNT];
+
+ $self->SUPER::init();
+}
+
+sub to_tap {
+ my $self = shift;
+ my ($num, $delayed) = @_;
+
+ unless($delayed) {
+ return if $self->[EXCEPTION]
+ && $self->[EXCEPTION]->isa('Test::Stream::Event::Bail');
+
+ return $self->SUPER::to_tap($num);
+ }
+
+ # Subtest final result first
+ $self->[NAME] =~ s/$/ {/mg;
+ my @out = (
+ $self->SUPER::to_tap($num),
+ $self->_render_events(@_),
+ [OUT_STD, "}\n"],
+ );
+ $self->[NAME] =~ s/ \{$//mg;
+ return @out;
+}
+
+sub _render_events {
+ my $self = shift;
+ my ($num, $delayed) = @_;
+
+ my $idx = 0;
+ my @out;
+ for my $e (@{$self->events}) {
+ next unless $e->can('to_tap');
+ $idx++ if $e->isa('Test::Stream::Event::Ok');
+ push @out => $e->to_tap($idx, $delayed);
+ }
+
+ for my $set (@out) {
+ $set->[1] =~ s/^/ /mg;
+ }
+
+ return @out;
+}
+
+sub extra_details {
+ my $self = shift;
+
+ my @out = $self->SUPER::extra_details();
+ my $plan = $self->[STATE]->[STATE_PLAN];
+ my $exception = $self->exception;
+
+ return (
+ @out,
+
+ events => $self->events || undef,
+
+ exception => $exception || undef,
+ plan => $plan || undef,
+
+ passing => $self->[STATE]->[STATE_PASSING],
+ count => $self->[STATE]->[STATE_COUNT],
+ failed => $self->[STATE]->[STATE_FAILED],
+ );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Event::Subtest - Subtest event
+
+=head1 DESCRIPTION
+
+This event is used to encapsulate subtests.
+
+=head1 SYNOPSYS
+
+B<YOU PROBABLY DO NOT WANT TO DIRECTLY GENERATE A SUBTEST EVENT>. See the
+C<subtest()> function from L<Test::More::Tools> instead.
+
+=head1 INHERITENCE
+
+the C<Test::Stream::Event::Subtest> class inherits from
+L<Test::Stream::Event::Ok> and shares all of its methods and fields.
+
+=head1 ACCESSORS
+
+=over 4
+
+=item my $se = $e->events
+
+This returns an arrayref with all events generated during the subtest.
+
+=item my $x = $e->exception
+
+If the subtest was killed by a C<skip_all> or C<BAIL_OUT> the event will be
+returned by this accessor.
+
+=back
+
+=head1 SUMMARY FIELDS
+
+C<Test::Stream::Event::Subtest> inherits all of the summary fields from
+L<Test::Stream::Event::Ok>.
+
+=over 4
+
+=item events => \@subevents
+
+An arrayref containing all the events generated within the subtest, including
+plans.
+
+=item exception => \$plan_or_bail
+
+If the subtest was aborted due to a bail-out or a skip_all, the event that
+caused the abort will be here (in addition to the events arrayref.
+
+=item plan => \$plan
+
+The plan event for the subtest, this may be auto-generated.
+
+=item passing => $bool
+
+True if the subtest was passing, false otherwise. This should not be confused
+with 'bool' inherited from L<Test::Stream::Event::Ok> which takes TODO into
+account.
+
+=item count => $num
+
+Number of tests run inside the subtest.
+
+=item failed => $num
+
+Number of tests that failed inside the subtest.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/ExitMagic.pm b/cpan/Test-Simple/lib/Test/Stream/ExitMagic.pm
new file mode 100644
index 0000000000..2294d01360
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/ExitMagic.pm
@@ -0,0 +1,259 @@
+package Test::Stream::ExitMagic;
+use strict;
+use warnings;
+
+require Test::Stream::ExitMagic::Context;
+
+use Test::Stream::ArrayBase(
+ accessors => [qw/pid done/],
+);
+
+sub init {
+ $_[0]->[PID] = $$;
+ $_[0]->[DONE] = 0;
+}
+
+sub do_magic {
+ my $self = shift;
+ my ($stream, $context) = @_;
+ return unless $stream;
+ return if $stream->no_ending && !$context;
+
+ # Don't bother with an ending if this is a forked copy. Only the parent
+ # should do the ending.
+ return unless $self->[PID] == $$;
+
+ # Only run once
+ return if $self->[DONE]++;
+
+ my $real_exit_code = $?;
+
+ my $plan = $stream->plan;
+ my $total = $stream->count;
+ my $fails = $stream->failed;
+
+ $context ||= Test::Stream::ExitMagic::Context->new([caller()], $stream);
+ $context->finish($total, $fails);
+
+ # Ran tests but never declared a plan or hit done_testing
+ return $self->no_plan_magic($stream, $context, $total, $fails, $real_exit_code)
+ if $total && !$plan;
+
+ # Exit if plan() was never called. This is so "require Test::Simple"
+ # doesn't puke.
+ return unless $plan;
+
+ # Don't do an ending if we bailed out.
+ if( $stream->bailed_out ) {
+ $stream->is_passing(0);
+ return;
+ }
+
+ # Figure out if we passed or failed and print helpful messages.
+ return $self->be_helpful_magic($stream, $context, $total, $fails, $plan, $real_exit_code)
+ if $total && $plan;
+
+ if ($plan->directive && $plan->directive eq 'SKIP') {
+ $? = 0;
+ return;
+ }
+
+ if($real_exit_code) {
+ $context->diag("Looks like your test exited with $real_exit_code before it could output anything.\n");
+ $stream->is_passing(0);
+ $? = $real_exit_code;
+ return;
+ }
+
+ unless ($total) {
+ $context->diag("No tests run!\n");
+ $stream->is_passing(0);
+ $? = 255;
+ return;
+ }
+
+ $stream->is_passing(0);
+ $? = 255;
+}
+
+sub no_plan_magic {
+ my $self = shift;
+ my ($stream, $context, $total, $fails, $real_exit_code) = @_;
+
+ $stream->is_passing(0);
+ $context->diag("Tests were run but no plan was declared and done_testing() was not seen.");
+
+ if($real_exit_code) {
+ $context->diag("Looks like your test exited with $real_exit_code just after $total.\n");
+ $? = $real_exit_code;
+ return;
+ }
+
+ # But if the tests ran, handle exit code.
+ if ($total && $fails) {
+ my $exit_code = $fails <= 254 ? $fails : 254;
+ $? = $exit_code;
+ return;
+ }
+
+ $? = 254;
+ return;
+}
+
+sub be_helpful_magic {
+ my $self = shift;
+ my ($stream, $context, $total, $fails, $plan, $real_exit_code) = @_;
+
+ my $planned = $plan->max;
+ my $num_extra = $plan->directive && $plan->directive eq 'NO PLAN' ? 0 : $total - $planned;
+
+ if ($num_extra != 0) {
+ my $s = $planned == 1 ? '' : 's';
+ $context->diag("Looks like you planned $planned test$s but ran $total.\n");
+ $stream->is_passing(0);
+ }
+
+ if($fails) {
+ my $s = $fails == 1 ? '' : 's';
+ my $qualifier = $num_extra == 0 ? '' : ' run';
+ $context->diag("Looks like you failed $fails test$s of ${total}${qualifier}.\n");
+ $stream->is_passing(0);
+ }
+
+ if($real_exit_code) {
+ $context->diag("Looks like your test exited with $real_exit_code just after $total.\n");
+ $stream->is_passing(0);
+ $? = $real_exit_code;
+ return;
+ }
+
+ my $exit_code;
+ if($fails) {
+ $exit_code = $fails <= 254 ? $fails : 254;
+ }
+ elsif($num_extra != 0) {
+ $exit_code = 255;
+ }
+ else {
+ $exit_code = 0;
+ }
+
+ $? = $exit_code;
+ return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::ExitMagic - Encapsulate the magic exit logic
+
+=head1 DESCRIPTION
+
+It's magic! well kinda..
+
+=head1 SYNOPSYS
+
+Don't use this yourself, let L<Test::Stream> handle it.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/ExitMagic/Context.pm b/cpan/Test-Simple/lib/Test/Stream/ExitMagic/Context.pm
new file mode 100644
index 0000000000..599631e61b
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/ExitMagic/Context.pm
@@ -0,0 +1,131 @@
+package Test::Stream::ExitMagic::Context;
+use strict;
+use warnings;
+
+use Test::Stream::ArrayBase(
+ base => 'Test::Stream::Context',
+);
+
+sub init {
+ $_[0]->[PID] = $$;
+ $_[0]->[ENCODING] = 'legacy';
+}
+
+sub snapshot { $_[0] }
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::ExitMagic::Context - Special context for use in an END block.
+
+=head1 DESCRIPTION
+
+L<Test::Stream> needs to accomplish some magic in an END block. In an END block
+it is not always possible to have a true/complete context object, so this
+trivial one is used instead.
+
+B<DO NOT USE THIS>. If you find yourself thinking that you should use this then
+B<STOP!> because you are very likely to be wrong.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Exporter.pm b/cpan/Test-Simple/lib/Test/Stream/Exporter.pm
new file mode 100644
index 0000000000..0f70a551d3
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Exporter.pm
@@ -0,0 +1,315 @@
+package Test::Stream::Exporter;
+use strict;
+use warnings;
+
+use Test::Stream::PackageUtil;
+use Test::Stream::Exporter::Meta;
+
+sub export;
+sub exports;
+sub default_export;
+sub default_exports;
+
+# Test::Stream::Carp uses this module.
+sub croak { require Carp; goto &Carp::croak }
+sub confess { require Carp; goto &Carp::confess }
+
+BEGIN { Test::Stream::Exporter::Meta->new(__PACKAGE__) };
+
+sub import {
+ my $class = shift;
+ my $caller = caller;
+
+ Test::Stream::Exporter::Meta->new($caller);
+
+ export_to($class, $caller, @_);
+}
+
+default_exports qw/export exports default_export default_exports/;
+exports qw/export_to export_meta/;
+
+default_export import => sub {
+ my $class = shift;
+ my $caller = caller;
+ my @args = @_;
+
+ my $stash = $class->before_import($caller, \@args) if $class->can('before_import');
+ export_to($class, $caller, @args);
+ $class->after_import($caller, $stash, @args) if $class->can('after_import');
+};
+
+sub export_meta {
+ my $pkg = shift || caller;
+ return Test::Stream::Exporter::Meta->get($pkg);
+}
+
+sub export_to {
+ my $class = shift;
+ my ($dest, @imports) = @_;
+
+ my $meta = export_meta($class)
+ || confess "$class is not an exporter!?";
+
+ my (@include, %exclude);
+ for my $import (@imports) {
+ if ($import =~ m/^!(.*)$/) {
+ $exclude{$1}++;
+ }
+ else {
+ push @include => $import;
+ }
+ }
+
+ @include = $meta->default unless @include;
+
+ for my $name (@include) {
+ next if $exclude{$name};
+
+ my $ref = $meta->exports->{$name}
+ || croak "$class does not export $name";
+
+ no strict 'refs';
+ $name =~ s/^[\$\@\%\&]//;
+ *{"$dest\::$name"} = $ref;
+ }
+}
+
+sub cleanup {
+ my $pkg = caller;
+ package_purge_sym($pkg, map {(CODE => $_)} qw/export exports default_export default_exports/);
+}
+
+sub export {
+ my ($name, $ref) = @_;
+ my $caller = caller;
+
+ my $meta = export_meta($caller) ||
+ confess "$caller is not an exporter!?";
+
+ $meta->add($name, $ref);
+}
+
+sub exports {
+ my $caller = caller;
+
+ my $meta = export_meta($caller) ||
+ confess "$caller is not an exporter!?";
+
+ $meta->add($_) for @_;
+}
+
+sub default_export {
+ my ($name, $ref) = @_;
+ my $caller = caller;
+
+ my $meta = export_meta($caller) ||
+ confess "$caller is not an exporter!?";
+
+ $meta->add_default($name, $ref);
+}
+
+sub default_exports {
+ my $caller = caller;
+
+ my $meta = export_meta($caller) ||
+ confess "$caller is not an exporter!?";
+
+ $meta->add_default($_) for @_;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Exporter - Declarative exporter for Test::Stream and friends.
+
+=head1 DESCRIPTION
+
+Test::Stream::Exporter is an internal implementation of some key features from
+L<Exporter::Declare>. This is a much more powerful exporting tool than
+L<Exporter>. This package is used to easily manage complicated EXPORT logic
+across L<Test::Stream> and friends.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Exporter;
+
+ # Export some named subs from the package
+ default_exports qw/foo bar baz/;
+ exports qw/fluxx buxx suxx/;
+
+ # Export some anonymous subs under specific names.
+ export some_tool => sub { ... };
+ default_export another_tool => sub { ... };
+
+ # Call this when you are done providing exports in order to cleanup your
+ # namespace.
+ Test::Stream::Exporter->cleanup;
+
+ # Hooks for import()
+
+ # Called before importing symbols listed in $args_ref. This gives you a
+ # chance to munge the arguments.
+ sub before_import {
+ my $class = shift;
+ my ($caller, $args_ref) = @_;
+ ...
+
+ return $stash; # For use in after_import, can be anything
+ }
+
+ # Chance to do something after import() is done
+ sub after_import {
+ my $class = shift;
+ my ($caller, $stash, @args) = @_;
+ ...
+ }
+
+=head1 EXPORTS
+
+=head2 DEFAULT
+
+=over 4
+
+=item import
+
+Your class needs this to function as an exporter.
+
+=item export NAME => sub { ... }
+
+=item default_export NAME => sub { ... }
+
+These are used to define exports that may not actually be subs in the current
+package.
+
+=item exports qw/foo bar baz/
+
+=item default_exports qw/foo bar baz/
+
+These let you export package subs en mass.
+
+=back
+
+=head2 AVAILABLE
+
+=over 4
+
+=item export_to($from, $dest, @symbols)
+
+=item $from->export_to($dest, @symbols)
+
+Export from the C<$from> package into the C<$dest> package. The class-method
+form only works if the method has been imported into the C<$from> package.
+
+=item $meta = export_meta($package)
+
+=item $meta = $package->export_meta()
+
+Get the export meta object from the package. The class method form only works
+if the package has imported it.
+
+=back
+
+=head1 HOOKS
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Exporter/Meta.pm b/cpan/Test-Simple/lib/Test/Stream/Exporter/Meta.pm
new file mode 100644
index 0000000000..fc055beda7
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Exporter/Meta.pm
@@ -0,0 +1,183 @@
+package Test::Stream::Exporter::Meta;
+use strict;
+use warnings;
+
+use Test::Stream::PackageUtil;
+
+# Test::Stream::Carp uses this module.
+sub croak { require Carp; goto &Carp::croak }
+sub confess { require Carp; goto &Carp::confess }
+
+sub exports { $_[0]->{exports} }
+sub default { @{$_[0]->{pdlist}} }
+sub all { @{$_[0]->{polist}} }
+
+sub add {
+ my $self = shift;
+ my ($name, $ref) = @_;
+
+ confess "Name is mandatory" unless $name;
+
+ confess "$name is already exported"
+ if $self->exports->{$name};
+
+ $ref ||= package_sym($self->{package}, CODE => $name);
+
+ confess "No reference or package sub found for '$name' in '$self->{package}'"
+ unless $ref && ref $ref;
+
+ $self->exports->{$name} = $ref;
+ push @{$self->{polist}} => $name;
+}
+
+sub add_default {
+ my $self = shift;
+ my ($name, $ref) = @_;
+
+ $self->add($name, $ref);
+ push @{$self->{pdlist}} => $name;
+
+ $self->{default}->{$name} = 1;
+}
+
+my %EXPORT_META;
+
+sub new {
+ my $class = shift;
+ my ($pkg) = @_;
+
+ confess "Package is required!"
+ unless $pkg;
+
+ $EXPORT_META{$pkg} ||= bless({
+ exports => {},
+ default => {},
+ pdlist => do { no strict 'refs'; no warnings 'once'; \@{"$pkg\::EXPORT"} },
+ polist => do { no strict 'refs'; no warnings 'once'; \@{"$pkg\::EXPORT_OK"} },
+ package => $pkg,
+ }, $class);
+
+ return $EXPORT_META{$pkg};
+}
+
+sub get {
+ my $class = shift;
+ my ($pkg) = @_;
+
+ confess "Package is required!"
+ unless $pkg;
+
+ return $EXPORT_META{$pkg};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Exporter::Meta - Meta object for exporters.
+
+=head1 DESCRIPTION
+
+L<Test::Stream::Exporter> uses this package to manage exports.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/IOSets.pm b/cpan/Test-Simple/lib/Test/Stream/IOSets.pm
new file mode 100644
index 0000000000..ae862776fd
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/IOSets.pm
@@ -0,0 +1,243 @@
+package Test::Stream::IOSets;
+use strict;
+use warnings;
+
+use Test::Stream::Util qw/protect/;
+
+init_legacy();
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+
+ $self->reset_legacy;
+
+ return $self;
+}
+
+sub init_encoding {
+ my $self = shift;
+ my ($name, @handles) = @_;
+
+ unless($self->{$name}) {
+ my ($out, $fail, $todo);
+
+ if (@handles) {
+ ($out, $fail, $todo) = @handles;
+ }
+ else {
+ ($out, $fail) = $self->open_handles();
+ }
+
+ binmode($out, ":encoding($name)");
+ binmode($fail, ":encoding($name)");
+
+ $self->{$name} = [$out, $fail, $todo || $out];
+ }
+
+ return $self->{$name};
+}
+
+my $LEGACY;
+sub hard_reset { $LEGACY = undef }
+sub init_legacy {
+ return if $LEGACY;
+
+ my ($out, $err) = open_handles();
+
+ _copy_io_layers(\*STDOUT, $out);
+ _copy_io_layers(\*STDERR, $err);
+
+ _autoflush($out);
+ _autoflush($err);
+
+ # LEGACY, BAH!
+ # This is necessary to avoid out of sequence writes to the handles
+ _autoflush(\*STDOUT);
+ _autoflush(\*STDERR);
+
+ $LEGACY = [$out, $err, $out];
+}
+
+sub reset_legacy {
+ my $self = shift;
+ init_legacy() unless $LEGACY;
+ my ($out, $fail, $todo) = @$LEGACY;
+ $self->{legacy} = [$out, $fail, $todo];
+}
+
+sub _copy_io_layers {
+ my($src, $dst) = @_;
+
+ protect {
+ require PerlIO;
+ my @src_layers = PerlIO::get_layers($src);
+ _apply_layers($dst, @src_layers) if @src_layers;
+ };
+
+ return;
+}
+
+sub _autoflush {
+ my($fh) = shift;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+
+ return;
+}
+
+sub open_handles {
+ open( my $out, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
+ open( my $err, ">&STDERR" ) or die "Can't dup STDERR: $!";
+
+ _autoflush($out);
+ _autoflush($err);
+
+ return ($out, $err);
+}
+
+sub _apply_layers {
+ my ($fh, @layers) = @_;
+ my %seen;
+ my @unique = grep { $_ !~ /^(unix|perlio)$/ && !$seen{$_}++ } @layers;
+ binmode($fh, join(":", "", "raw", @unique));
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::IOSets - Manage sets of IO Handles in specific encodings.
+
+=head1 DESCRIPTION
+
+The module does 2 things, first it emulates the old behavior of
+L<Test::Builder> which clones and modifies the STDOUT and STDERR handles. This
+legacy behavior can be referenced as C<'legacy'> in place of an encoding. It
+also manages multiple clones of the standard file handles which are set to
+specific encodings.
+
+=head1 METHODS
+
+In general you should not use this module yourself. If you must use it directly
+then there is really only 1 method you should use:
+
+=over 4
+
+=item $ar = $ioset->init_encoding($ENCODING)
+
+=item $ar = $ioset->init_encoding('legacy')
+
+=item $ar = $ioset->init_encoding($NAME, $STDOUT, $STDERR)
+
+C<init_encoding()> will return an arrayref of 3 filehandles, STDOUT, STDERR,
+and TODO. TODO is typically just STDOUT again. If the encoding specified has
+not yet been initialized it will initialize it. If you provide filehandles they
+will be used, but only during initializatin. Typically a filehandle set is
+created by cloning STDER and STDOUT and modifying them to use the correct
+encoding.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Meta.pm b/cpan/Test-Simple/lib/Test/Stream/Meta.pm
new file mode 100644
index 0000000000..9f7b6d38c3
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Meta.pm
@@ -0,0 +1,202 @@
+package Test::Stream::Meta;
+use strict;
+use warnings;
+
+use Scalar::Util();
+use Test::Stream::Util qw/protect/;
+
+use Test::Stream::ArrayBase(
+ accessors => [qw/package encoding modern todo stream/],
+);
+
+use Test::Stream::PackageUtil;
+
+use Test::Stream::Exporter qw/import export_to default_exports/;
+default_exports qw{ is_tester init_tester };
+Test::Stream::Exporter->cleanup();
+
+my %META;
+
+sub snapshot {
+ my $self = shift;
+ my $class = Scalar::Util::blessed($self);
+ return bless [@$self], $class;
+}
+
+sub is_tester {
+ my $pkg = shift;
+ return $META{$pkg};
+}
+
+sub init_tester {
+ my $pkg = shift;
+ $META{$pkg} ||= bless [$pkg, 'legacy', 0, undef], __PACKAGE__;
+ return $META{$pkg};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Meta - Meta object for unit test packages.
+
+=head1 DESCRIPTION
+
+This object is used to track metadata for unit tests packages.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Meta qw/init_tester is_tester/;
+
+ sub import {
+ my $class = shift;
+ my $caller = caller;
+
+ my $meta = init_tester($caller);
+ }
+
+ sub check_stuff {
+ my $caller = caller;
+ my $meta = is_tester($caller) || return;
+
+ ...
+ }
+
+=head1 EXPORTS
+
+=over 4
+
+=item $meta = is_tester($package)
+
+Get the meta object for a specific package, if it has one.
+
+=item $meta = init_tester($package)
+
+Get the meta object for a specific package, or create one.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $meta_copy = $meta->snapshot
+
+Get a snapshot copy of the metadata. This snapshot will not change when the
+original does.
+
+=item $val = $meta->package
+
+=item $val = $meta->encoding
+
+=item $val = $meta->modern
+
+=item $val = $meta->todo
+
+=item $val = $meta->stream
+
+These are various attributes stored on the meta object.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm b/cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm
new file mode 100644
index 0000000000..e8bb70be49
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm
@@ -0,0 +1,188 @@
+package Test::Stream::PackageUtil;
+use strict;
+use warnings;
+
+sub confess { require Carp; goto &Carp::confess }
+
+my @SLOTS = qw/HASH SCALAR ARRAY IO FORMAT CODE/;
+my %SLOTS = map {($_ => 1)} @SLOTS;
+
+sub import {
+ my $caller = caller;
+ no strict 'refs';
+ *{"$caller\::package_sym"} = \&package_sym;
+ *{"$caller\::package_purge_sym"} = \&package_purge_sym;
+ 1;
+}
+
+sub package_sym {
+ my ($pkg, $slot, $name) = @_;
+ confess "you must specify a package" unless $pkg;
+ confess "you must specify a symbol type" unless $slot;
+ confess "you must specify a symbol name" unless $name;
+
+ confess "'$slot' is not a valid symbol type! Valid: " . join(", ", @SLOTS)
+ unless $SLOTS{$slot};
+
+ no warnings 'once';
+ no strict 'refs';
+ return *{"$pkg\::$name"}{$slot};
+}
+
+sub package_purge_sym {
+ my ($pkg, @pairs) = @_;
+
+ for(my $i = 0; $i < @pairs; $i += 2) {
+ my $purge = $pairs[$i];
+ my $name = $pairs[$i + 1];
+
+ confess "'$purge' is not a valid symbol type! Valid: " . join(", ", @SLOTS)
+ unless $SLOTS{$purge};
+
+ no strict 'refs';
+ local *GLOBCLONE = *{"$pkg\::$name"};
+ undef *{"$pkg\::$name"};
+ for my $slot (@SLOTS) {
+ next if $slot eq $purge;
+ *{"$pkg\::$name"} = *GLOBCLONE{$slot} if defined *GLOBCLONE{$slot};
+ }
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::PackageUtil - Utils for manipulating package symbol tables.
+
+=head1 DESCRIPTION
+
+Collection of utilities L<Test::Stream> and friends use to manipulate package
+symbol tables. This is primarily useful when trackign things like C<$TODO>
+vars. It is also used for exporting and meta-construction of object methods.
+
+=head1 EXPORTS
+
+Both exports are exported by default, you cannot pick and choose. These work
+equally well as functions and class-methods. These will not work as object
+methods.
+
+=over 4
+
+=item $ref = package_sym($PACKAGE, $SLOT => $NAME)
+
+Get the reference to a symbol in the package. C<$PACKAGE> should be the package
+name. C<$SLOT> should be a valid typeglob slot (Supported slots: HASH SCALAR ARRAY
+IO FORMAT CODE). C<$NAME> should be the name of the symbol.
+
+=item package_purge_sym($PACKAGE, $SLOT => $NAME, $SLOT2 => $NAME2, ...)
+
+This is used to remove symbols from a package. The first argument, C<$PACKAGE>,
+should be the name of the package. The remaining arguments should be key/value
+pairs. The key in each pair should be the typeglob slot to clear (Supported
+slots: HASH SCALAR ARRAY IO FORMAT CODE). The value in the pair should be the
+name of the symbol to remove.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Tester.pm b/cpan/Test-Simple/lib/Test/Stream/Tester.pm
new file mode 100644
index 0000000000..f8ebb7c6a5
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Tester.pm
@@ -0,0 +1,725 @@
+package Test::Stream::Tester;
+use strict;
+use warnings;
+
+use Test::Builder 1.301001;
+use Test::Stream;
+use Test::Stream::Util qw/try is_regex/;
+
+use B;
+
+use Scalar::Util qw/blessed reftype/;
+use Test::Stream::Carp qw/croak carp/;
+
+use Test::Stream::Tester::Checks;
+use Test::Stream::Tester::Checks::Event;
+use Test::Stream::Tester::Events;
+use Test::Stream::Tester::Events::Event;
+
+use Test::Stream::Toolset;
+use Test::Stream::Exporter;
+default_exports qw{
+ intercept grab
+
+ events_are
+ check event directive
+};
+
+default_export dir => \&directive;
+Test::Stream::Exporter->cleanup;
+
+sub grab {
+ require Test::Stream::Tester::Grab;
+ return Test::Stream::Tester::Grab->new;
+}
+
+our $EVENTS;
+sub check(&) {
+ my ($code) = @_;
+
+ my $o = B::svref_2object($code);
+ my $st = $o->START;
+ my $file = $st->file;
+ my $line = $st->line;
+
+ local $EVENTS = Test::Stream::Tester::Checks->new($file, $line);
+
+ my @out = $code->($EVENTS);
+
+ if (@out) {
+ if ($EVENTS->populated) {
+ carp "sub used in check(&) returned values, did you forget to prefix an event with 'event'?"
+ }
+ else {
+ croak "No events were produced by sub in check(&), but the sub returned some values, did you forget to prefix an event with 'event'?";
+ }
+ }
+
+ return $EVENTS;
+}
+
+sub event($$) {
+ my ($type, $data) = @_;
+
+ croak "event() cannot be used outside of a check { ... } block"
+ unless $EVENTS;
+
+ my $etypes = Test::Stream::Context->events;
+ croak "'$type' is not a valid event type!"
+ unless $etypes->{$type};
+
+ my $props;
+
+ croak "event() takes a type, followed by a hashref"
+ unless ref $data && reftype $data eq 'HASH';
+
+ # Make a copy
+ $props = { %{$data} };
+
+ my @call = caller(0);
+ $props->{debug_package} = $call[0];
+ $props->{debug_file} = $call[1];
+ $props->{debug_line} = $call[2];
+
+ $EVENTS->add_event($type, $props);
+ return ();
+}
+
+sub directive($;$) {
+ my ($directive, @args) = @_;
+
+ croak "directive() cannot be used outside of a check { ... } block"
+ unless $EVENTS;
+
+ croak "No directive specified"
+ unless $directive;
+
+ if (!ref $directive) {
+ croak "Directive '$directive' requires exactly 1 argument"
+ unless (@args && @args == 1) || $directive eq 'end';
+ }
+ else {
+ croak "directives must be a predefined name, or a sub ref"
+ unless reftype($directive) eq 'CODE';
+ }
+
+ $EVENTS->add_directive(@_);
+ return ();
+}
+
+sub intercept(&) {
+ my ($code) = @_;
+
+ my @events;
+
+ my ($ok, $error) = try {
+ Test::Stream->intercept(
+ sub {
+ my $stream = shift;
+ $stream->listen(
+ sub {
+ shift; # Stream
+ push @events => @_;
+ }
+ );
+ $code->();
+ }
+ );
+ };
+
+ die $error unless $ok || (blessed($error) && $error->isa('Test::Stream::Event'));
+
+ return \@events;
+}
+
+sub events_are {
+ my ($events, $checks, $name) = @_;
+
+ croak "Did not get any events"
+ unless $events;
+
+ croak "Did not get any checks"
+ unless $checks;
+
+ croak "checks must be an instance of Test::Stream::Tester::Checks"
+ unless blessed($checks)
+ && $checks->isa('Test::Stream::Tester::Checks');
+
+ my $ctx = context();
+
+ # use $_[0] directly so that the variable used in the method call can be undef'd
+ $events = $_[0]->finish
+ if blessed($events)
+ && $events->isa('Test::Stream::Tester::Grab');
+
+ $events = Test::Stream::Tester::Events->new(@$events)
+ if ref($events)
+ && reftype($events) eq 'ARRAY';
+
+ croak "'$events' is not a valid set of events."
+ unless $events
+ && blessed($events)
+ && $events->isa('Test::Stream::Tester::Events');
+
+ my ($ok, @diag) = $checks->run($events);
+
+ $ctx->ok($ok, $name, \@diag);
+ return $ok;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Tester - Tools for validating the events produced by your testing
+tools.
+
+=head1 DESCRIPTION
+
+There are tools to validate your code. This library provides tools to validate
+your tools!
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use Test::Stream::Tester;
+
+ events_are(
+ # Capture all the events within the block
+ intercept {
+ ok(1, "pass");
+ ok(0, "fail");
+ diag("xxx");
+ },
+
+ # Describe what we expect to see
+ check {
+ event ok => {bool => 1, name => 'pass'};
+ event ok => {
+ bool => 0,
+ name => 'fail',
+
+ # Ignores any fields in the result we don't list
+ # real_bool, line, file, tool_package, tool_name, etc...
+
+ # Diagnostics generated by a test are typically linked to those
+ # results (new and updated tools only) They can be validated.
+ diag => qr/^Failed test /,
+ };
+ event diag => {message => 'xxx'};
+ directive 'end'; # enforce that there are no more results
+ },
+
+ "This is the name of our test"
+ );
+
+ done_testing;
+
+=head2 GRAB WITH NO ADDED STACK
+
+ use Test::More;
+ use Test::Stream::Tester;
+
+ # Start capturing events. We use grab() instead of intercept {} to avoid
+ # adding stack frames.
+ my $grab = grab();
+
+ # Generate some events.
+ ok(1, "pass");
+ ok(0, "fail");
+ diag("xxx");
+
+ # Stop capturing events, and validate the ones recieved.
+ events_are(
+ $grab,
+ check {
+ event ok => { bool => 1, name => 'pass' };
+ event ok => { bool => 0, name => 'fail' };
+ event diag => { message => 'xxx' };
+ directive 'end';
+ },
+ 'Validate our Grab results';
+ );
+
+ # $grab is now undef, it no longer exists.
+ is($grab, undef, '$grab was destroyed for us.');
+
+ ok(!$success, "Eval did not succeed, BAIL_OUT killed the test");
+
+ # Make sure we got the event as an exception
+ isa_ok($error, 'Test::Stream::Event::Bail');
+
+ done_testing
+
+=head1 EXPORTS
+
+=over 4
+
+=item $events = intercept { ... }
+
+=item $events = intercept(sub { ... })
+
+Capture the L<Test::Builder::Event> objects generated by tests inside the block.
+
+=item events_are(\@events, $check)
+
+=item events_are(\@events, $check, $name)
+
+=item events_are($events, $check)
+
+=item events_are($events, $check, $name)
+
+=item events_are($grab, $check)
+
+=item events_are($grab, $check, $name)
+
+The first argument may be either an arrayref of L<Test::Stream::Event> objects,
+an L<Test::Stream::Tester::Grab> object, or an L<Test::Stream::Tester::Events>
+object. C<intercept { ... }> can be used to capture events within a block of
+code, including plans such as C<skip_all>, and things that normally kill the
+test like C<BAIL_OUT()>.
+
+The second argument must be an L<Test::Stream::Tester::Checks> object.
+Typically these are generated using C<check { ... }>.
+
+The third argument is the name of the test, it is optional, but highly
+recommended.
+
+=item $checks = check { ... };
+
+Produce an array of expected events for use in events_are.
+
+ my $check = check {
+ event ok => { ... };
+ event diag => { ... };
+ directive 'end';
+ };
+
+If the block passed to check returns anything at all it will warn you as this
+usually means you forgot to use the C<event> and/or C<diag> functions. If it
+returns something AND has no events it will be fatal.
+
+C<event()> and C<directive()> both return nothing, this means that if you use
+them alone your codeblock will return nothing.
+
+=item event TYPE => { ... };
+
+Define an event and push it onto the list that will be returned by the
+enclosing C<check { ... }> block. Will fail if run outside a check block. This
+will fail if you give it an invalid event type.
+
+If you wish to acknowledge the event, but not check anything you may simply
+give it an empty hashref.
+
+The line number where the event was generated is recorded for helpful debugging
+in event of a failure.
+
+B<CAVEAT> The line number is inexact because of the way perl records it. The
+line number is taken from C<caller>.
+
+=item dir 'DIRECTIVE';
+
+=item dir DIRECTIVE => 'ARG';
+
+=item dir sub { ... };
+
+=item dir sub { ... }, $arg;
+
+=item directive 'DIRECTIVE';
+
+=item directive DIRECTIVE => 'ARG';
+
+=item directive sub { ... };
+
+=item directive sub { ... }, $arg;
+
+Define a directive and push it onto the list that will be returned by the
+enclosing C<check { ... }> block. This will fail if run outside of a check
+block.
+
+The first argument must be either a codeblock, or one of the name of a
+predefined directive I<See the directives section>.
+
+Coderefs will be given 3 arguments:
+
+ sub {
+ my ($checks, $events, $arg) = @_;
+ ...
+ }
+
+C<$checks> is the L<Test::Stream::Tester::Checks> object. C<$events> is the
+L<Test::Stream::Tester::Events> object. C<$arg> is whatever argument you passed
+via the C<directive()> call.
+
+Most directives will act on the C<$events> object to remove or alter events.
+
+=back
+
+=head1 INTERCEPTING EVENTS
+
+ my $events = intercept {
+ ok(1, "pass");
+ ok(0, "fail");
+ diag("xxx");
+ };
+
+Any events generated within the block will be intercepted and placed inside
+the C<$events> array reference.
+
+=head2 EVENT TYPES
+
+All events will be subclasses of L<Test::Builder::Event>
+
+=over 4
+
+=item L<Test::Builder::Event::Ok>
+
+=item L<Test::Builder::Event::Note>
+
+=item L<Test::Builder::Event::Diag>
+
+=item L<Test::Builder::Event::Plan>
+
+=item L<Test::Builder::Event::Finish>
+
+=item L<Test::Builder::Event::Bail>
+
+=item L<Test::Builder::Event::Subtest>
+
+=back
+
+=head1 VALIDATING EVENTS
+
+You can validate events by hand using traditional test tools such as
+C<is_deeply()> against the $events array returned from C<intercept()>. However
+it is easier to use C<events_are()> paried with C<checks> objects build using
+C<checks { ... }>.
+
+ events_are(
+ intercept {
+ ok(1, "pass");
+ ok(0, "fail");
+ diag("xxx");
+ },
+
+ check {
+ event ok => { bool => 1, name => 'pass' };
+ event ok => { bool => 0, name => 'fail' };
+ event diag => {message => 'xxx'};
+ directive 'end';
+ },
+
+ "This is the name of our test"
+ );
+
+=head2 WHAT DOES THIS BUY ME?
+
+C<checks { ... }>, C<event()>, and C<directive()>, work together to produce a
+nested set of objects to represent what you want to see. This was chosen over a
+hash/list system for 2 reasons:
+
+=over 4
+
+=item Better Diagnostics
+
+Whenever you use C<checks { ... }>, C<events()>, and C<directive()> it records
+the filename and line number where they are called. When a test fails the
+diagnostics will include this information so that you know where the error
+occured. In a hash/list based system this information is not available.
+
+A hash based system is not practical as you may generate several events of the
+same type, and in a hash duplicated keys are squashed (last one wins).
+
+A list based system works, but then a failure reports the index of the failure,
+this requires you to manually count events to find the correct one. Originally
+I tried letting you specify an ID for the events, but this proved annoying.
+
+Ultimately I am very happy with the diagnostics this allows. It is very nice to
+see what is essentially a simple trace showing where the event and check were
+generated. It also shows you the items leading to the failure in the event of
+nested checks.
+
+=item Loops and other constructs
+
+In a list based system you are limited in what you can produce. You can
+generate the list in advance, then pass it in, but this is hard to debug.
+Alternatively you can use C<map> to produce repeated events, but this is
+equally hard to debug.
+
+This system lets you call C<event()> and C<directive()> in loops directly. It
+also lets you write functions that produce them based on input for reusable
+test code.
+
+=back
+
+=head2 VALIDATING FIELDS
+
+The hashref against which events are checked is composed of keys, and values.
+The values may be regular values, which are checked for equality with the
+corresponding property of the event object. Alternatively you can provide a
+regex to match against, or an arrayref of regexes (each one must match).
+
+=over 4
+
+=item field => 'exact_value',
+
+The specified field must exactly match the given value, be it number or string.
+
+=item field => qr/.../,
+
+The specified field must match the regular expression.
+
+=item field => [qr/.../, qr/.../, ...],
+
+The value of the field must match ALL the regexes.
+
+=item field => sub { ... }
+
+Specify a sub that will validate the value of the field.
+
+ foo => sub {
+ my ($key, $val) = @_;
+
+ ...
+
+ # Return true (valid) or false, and any desired diagnostics messages.
+ return($bool, @diag);
+ },
+
+=back
+
+=head2 WHAT FIELDS ARE AVAILABLE?
+
+This is specific to the event type. All events inherit from
+L<Test::Builder::Event> which provides a C<summary()> method. The C<summary()>
+method returns a list of key/value pairs I<(not a reference!)> with all fields
+that are for public consumption.
+
+For each of the following modules see the B<SUMMARY FIELDS> section for a list
+of fields made available. These fields are inherited when events are
+subclassed, and all events have the summary fields present in
+L<Test::Builder::Event>.
+
+=over 4
+
+=item L<Test::Builder::Event/"SUMMARY FIELDS">
+
+=item L<Test::Builder::Event::Ok/"SUMMARY FIELDS">
+
+=item L<Test::Builder::Event::Note/"SUMMARY FIELDS">
+
+=item L<Test::Builder::Event::Diag/"SUMMARY FIELDS">
+
+=item L<Test::Builder::Event::Plan/"SUMMARY FIELDS">
+
+=item L<Test::Builder::Event::Finish/"SUMMARY FIELDS">
+
+=item L<Test::Builder::Event::Bail/"SUMMARY FIELDS">
+
+=item L<Test::Builder::Event::Subtest/"SUMMARY FIELDS">
+
+=back
+
+=head2 DIRECTIVES
+
+Directives give you a chance to alter the list of events part-way through the
+check, or to make the check skip/ignore events based on conditions.
+
+=head3 skip
+
+Skip will skip a specific number of events at that point in the check.
+
+=over 4
+
+=item directive skip => $num;
+
+ my $events = intercept {
+ ok(1, "foo");
+ diag("XXX");
+
+ ok(1, "bar");
+ diag("YYY");
+
+ ok(1, "baz");
+ diag("ZZZ");
+ };
+
+ events_are(
+ $events,
+ ok => { name => "foo" },
+
+ skip => 1, # Skips the diag 'XXX'
+
+ ok => { name => "bar" },
+
+ skip => 2, # Skips the diag 'YYY' and the ok 'baz'
+
+ diag => { message => 'ZZZ' },
+ );
+
+=back
+
+=head3 seek
+
+When turned on (true), any unexpected events will be skipped. You can turn
+this on and off any time by using it again with a false argument.
+
+=over 4
+
+=item directive seek => $BOOL;
+
+ my $events = intercept {
+ ok(1, "foo");
+
+ diag("XXX");
+ diag("YYY");
+
+ ok(1, "bar");
+ diag("ZZZ");
+
+ ok(1, "baz");
+ };
+
+ events_are(
+ $events,
+
+ seek => 1,
+ ok => { name => "foo" },
+ # The diags are ignored, it will seek to the next 'ok'
+ ok => { name => "bar" },
+
+ seek => 0,
+
+ # This will fail because the diag is not ignored anymore.
+ ok => { name => "baz" },
+ );
+
+=back
+
+=head3 end
+
+Used to say that there should not be any more events. Without this any events
+after your last check are simply ignored. This will generate a failure if any
+unchecked events remain.
+
+=over 4
+
+=item directive 'end';
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::Tester> *Deprecated*
+
+A nice, but very limited tool for testing 'ok' results.
+
+=item L<Test::Builder::Tester> *Deprecated*
+
+The original test tester, checks TAP output as giant strings.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Tester/Checks.pm b/cpan/Test-Simple/lib/Test/Stream/Tester/Checks.pm
new file mode 100644
index 0000000000..b441d9dd99
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Tester/Checks.pm
@@ -0,0 +1,401 @@
+package Test::Stream::Tester::Checks;
+use strict;
+use warnings;
+
+use Test::Stream::Carp qw/croak confess/;
+use Test::Stream::Util qw/is_regex/;
+
+use Scalar::Util qw/blessed reftype/;
+
+my %DIRECTIVES = (
+ map { $_ => __PACKAGE__->can($_) }
+ qw(filter_providers filter_types skip seek end)
+);
+
+sub new {
+ my $class = shift;
+ my ($file, $line) = @_;
+ my $self = bless {
+ seek => 0,
+ items => [],
+ file => $file,
+ line => $line,
+ }, $class;
+ return $self;
+}
+
+sub debug {
+ my $self = shift;
+ return "Checks from $self->{file} around line $self->{line}.";
+}
+
+sub populated { scalar @{shift->{items}} }
+
+sub add_directive {
+ my $self = shift;
+ my ($dir, @args) = @_;
+
+ confess "No directive provided!"
+ unless $dir;
+
+ if (ref($dir)) {
+ confess "add_directive takes a coderef, or name, and optional args. (got $dir)"
+ unless reftype($dir) eq 'CODE';
+ }
+ else {
+ confess "$dir is not a valid directive."
+ unless $DIRECTIVES{$dir};
+ $dir = $DIRECTIVES{$dir};
+ }
+
+ push @{$self->{items}} => [$dir, @args];
+}
+
+sub add_event {
+ my $self = shift;
+ my ($type, $spec) = @_;
+
+ confess "add_event takes a type name and a hashref"
+ unless $type && $spec && ref $spec && reftype($spec) eq 'HASH';
+
+ my $e = Test::Stream::Tester::Checks::Event->new(%$spec, type => $type);
+ push @{$self->{items}} => $e;
+}
+
+sub include {
+ my $self = shift;
+ my ($other) = @_;
+
+ confess "Invalid argument to include()"
+ unless $other && blessed($other) && $other->isa(__PACKAGE__);
+
+ push @{$self->{items}} => @{$other->{items}};
+}
+
+sub run {
+ my $self = shift;
+ my ($events) = @_;
+ $events = $events->clone;
+
+ for (my $i = 0; $i < @{$self->{items}}; $i++) {
+ my $item = $self->{items}->[$i];
+
+ # Directive
+ if (reftype $item eq 'ARRAY') {
+ my ($code, @args) = @$item;
+ my @out = $self->$code($events, @args);
+ next unless @out;
+ return @out;
+ }
+
+ # Event!
+ my $meth = $self->{seek} ? 'seek' : 'next';
+ my $event = $events->$meth($item->get('type'));
+
+ my ($ret, @debug) = $self->check_event($item, $event);
+ return ($ret, @debug) unless $ret;
+ }
+
+ return (1);
+}
+
+sub vtype {
+ my ($v) = @_;
+
+ if (blessed($v)) {
+ return 'checks' if $v->isa('Test::Stream::Tester::Checks');
+ return 'events' if $v->isa('Test::Stream::Tester::Events');
+ return 'check' if $v->isa('Test::Stream::Tester::Checks::Event');
+ return 'event' if $v->isa('Test::Stream::Tester::Events::Event');
+ }
+
+ return 'regexp' if is_regex($v);
+ return 'noref' unless ref $v;
+ return 'array' if reftype($v) eq 'ARRAY';
+ return 'code' if reftype($v) eq 'CODE';
+
+ confess "Invalid field check: '$v'";
+}
+
+sub check_event {
+ my $self = shift;
+ my ($want, $got) = @_;
+
+ my @debug = (" Check: " . $want->debug);
+ my $wtype = $want->get('type');
+
+ return (0, @debug, " Expected event of type '$wtype', but did not find one.")
+ unless defined($got);
+
+ unshift @debug => " Event: " . $got->debug;
+ my $gtype = $got->get('type');
+
+ return (0, @debug, " Expected event of type '$wtype', but got '$gtype'.")
+ unless $wtype eq $gtype;
+
+ for my $key ($want->keys) {
+ my $wval = $want->get($key);
+ my $gval = $got->get($key);
+
+ my ($ret, @err) = $self->check_key($key, $wval, $gval);
+ return ($ret, @debug, @err) unless $ret;
+ }
+
+ return (1);
+}
+
+sub check_key {
+ my $self = shift;
+ my ($key, $wval, $gval) = @_;
+
+ if ((defined $wval) xor(defined $gval)) {
+ $wval = defined $wval ? "'$wval'" : 'undef';
+ $gval = defined $gval ? "'$gval'" : 'undef';
+ return (0, " \$got->{$key} = $gval", " \$exp->{$key} = $wval",);
+ }
+
+ my $wtype = vtype($wval);
+
+ my $meth = "_check_field_$wtype";
+ return $self->$meth($key, $wval, $gval);
+}
+
+sub _check_field_checks {
+ my $self = shift;
+ my ($key, $wval, $gval) = @_;
+
+ my $debug = $wval->debug;
+
+ return (0, " \$got->{$key} = '$gval'", " \$exp->{$key} = <$debug>")
+ unless vtype($gval) eq 'events';
+
+ my ($ret, @diag) = $wval->run($gval);
+ return $ret if $ret;
+ return ($ret, map { s/^/ /mg; $_ } @diag);
+}
+
+sub _check_field_check {
+ my $self = shift;
+ my ($key, $wval, $gval) = @_;
+
+ my $debug = $wval->debug;
+
+ return (0, "Event: INVALID EVENT ($gval)", " Check: $debug")
+ unless vtype($gval) eq 'event';
+
+ my ($ret, @diag) = check_event($wval, $gval);
+ return $ret if $ret;
+
+ return ($ret, map { s/^/ /mg; $_ } @diag);
+}
+
+sub _check_field_noref {
+ my $self = shift;
+ my ($key, $wval, $gval) = @_;
+
+ return (1) if !defined($wval) && !defined($gval);
+ return (1) if defined($wval) && defined($gval) && "$wval" eq "$gval";
+ $wval = "'$wval'" if defined $wval;
+ $wval ||= 'undef';
+ $gval = "'$gval'" if defined $gval;
+ $gval ||= 'undef';
+ return (0, " \$got->{$key} = $gval", " \$exp->{$key} = $wval");
+}
+
+sub _check_field_regexp {
+ my $self = shift;
+ my ($key, $wval, $gval) = @_;
+
+ return (1) if $gval =~ /$wval/;
+ return (0, " \$got->{$key} = '$gval'", " Does not match $wval");
+}
+
+sub _check_field_array {
+ my $self = shift;
+ my ($key, $wval, $gval) = @_;
+ for my $p (@$wval) {
+ my ($ret, @diag) = $self->_check_field_regexp($key, $p, $gval);
+ return ($ret, @diag) unless $ret;
+ }
+
+ return (1);
+}
+
+sub _check_field_code {
+ my $self = shift;
+ my ($key, $wval, $gval) = @_;
+ $wval->($key, $gval);
+}
+
+sub seek {
+ my $self = shift;
+ my ($events, $flag) = @_;
+
+ $self->{seek} = $flag ? 1 : 0;
+
+ return (); # Cannot fail
+}
+
+sub skip {
+ my $self = shift;
+ my ($events, $num) = @_;
+ $events->next while $num--;
+ return ();
+}
+
+sub end {
+ my $self = shift;
+ my ($events) = @_;
+ my $event = $events->next;
+ return () unless $event;
+ return (0, " Expected end of events, got " . $event->debug);
+}
+
+sub filter_providers {
+ my $self = shift;
+ my ($events, $arg) = @_;
+
+ my ($neg, $val) = $arg =~ m/^(!?)(.*)$/;
+ if ($neg) {
+ @$events = grep { $_->get('tool_package') ne $val } @$events;
+ }
+ else {
+ @$events = grep { $_->get('tool_package') eq $val } @$events;
+ }
+
+ return ();
+}
+
+sub filter_types {
+ my $self = shift;
+ my ($events, $arg) = @_;
+
+ my ($neg, $val) = $arg =~ m/^(!?)(.*)$/;
+ if ($neg) {
+ @$events = grep { $_->get('type') ne $val } @$events;
+ }
+ else {
+ @$events = grep { $_->get('type') eq $val } @$events;
+ }
+
+ return ();
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Tester::Checks - Representation of a L<Test::Stream::Tester>
+event check.
+
+=head1 DESCRIPTION
+
+L<Test::Stream::Tester> produces this object whenever you use C<check { ... }>.
+In general you will not interact with this object directly beyond pasing it
+into C<events_are>.
+
+B<Note:> The API for this object is not published and is subject to change. No backwords
+compatability can be guarenteed if you use this object directly. Please only
+use this object in the published way specified in L<Test::Stream::Tester>.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Tester/Checks/Event.pm b/cpan/Test-Simple/lib/Test/Stream/Tester/Checks/Event.pm
new file mode 100644
index 0000000000..91341a1aa1
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Tester/Checks/Event.pm
@@ -0,0 +1,194 @@
+package Test::Stream::Tester::Checks::Event;
+use strict;
+use warnings;
+
+use Test::Stream::Util qw/is_regex/;
+use Test::Stream::Carp qw/confess croak/;
+
+use Scalar::Util qw/blessed reftype/;
+
+sub new {
+ my $class = shift;
+ my $fields = {@_};
+ my $self = bless {fields => $fields}, $class;
+
+ $self->{$_} = delete $fields->{$_}
+ for qw/debug_line debug_file debug_package/;
+
+ map { $self->validate_check($_) } values %$fields;
+
+ my $type = $self->get('type') || confess "No type specified!";
+
+ my $etypes = Test::Stream::Context->events;
+ confess "'$type' is not a valid event type"
+ unless $etypes->{$type};
+
+ return $self;
+}
+
+sub debug_line { shift->{debug_line} }
+sub debug_file { shift->{debug_file} }
+sub debug_package { shift->{debug_package} }
+
+sub debug {
+ my $self = shift;
+
+ my $type = $self->get('type');
+ my $file = $self->debug_file;
+ my $line = $self->debug_line;
+
+ return "'$type' from $file line $line.";
+}
+
+sub keys { sort keys %{shift->{fields}} }
+
+sub exists {
+ my $self = shift;
+ my ($field) = @_;
+ return exists $self->{fields}->{$field};
+}
+
+sub get {
+ my $self = shift;
+ my ($field) = @_;
+ return $self->{fields}->{$field};
+}
+
+sub validate_check {
+ my $self = shift;
+ my ($val) = @_;
+
+ return unless defined $val;
+ return unless ref $val;
+ return if is_regex($val);
+
+ if (blessed($val)) {
+ return if $val->isa('Test::Stream::Tester::Checks');
+ return if $val->isa('Test::Stream::Tester::Events');
+ return if $val->isa('Test::Stream::Tester::Checks::Event');
+ return if $val->isa('Test::Stream::Tester::Events::Event');
+ }
+
+ my $type = reftype($val);
+ return if $type eq 'CODE';
+
+ croak "'$val' is not a valid field check"
+ unless reftype($val) eq 'ARRAY';
+
+ croak "Arrayrefs given as field checks may only contain regexes"
+ if grep { !is_regex($_) } @$val;
+
+ return;
+}
+
+1;
+
+=head1 NAME
+
+Test::Stream::Tester::Checks::Event - Representation of an event validation
+specification.
+
+=head1 DESCRIPTION
+
+Used internally by L<Test::Stream::Tester>. Please do not use directly. No
+backwords compatability will be provided if the API for this module changes.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Tester/Events.pm b/cpan/Test-Simple/lib/Test/Stream/Tester/Events.pm
new file mode 100644
index 0000000000..36ee93ec64
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Tester/Events.pm
@@ -0,0 +1,166 @@
+package Test::Stream::Tester::Events;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed/;
+
+use Test::Stream::Tester::Events::Event;
+
+sub new {
+ my $class = shift;
+ my $self = bless [map { Test::Stream::Tester::Events::Event->new($_->summary) } @_], $class;
+ return $self;
+}
+
+sub next { shift @{$_[0]} };
+
+sub seek {
+ my $self = shift;
+ my ($type) = @_;
+
+ while (my $e = shift @$self) {
+ return $e if $e->{type} eq $type;
+ }
+
+ return undef;
+}
+
+sub clone {
+ my $self = shift;
+ my $class = blessed($self);
+ return bless [@$self], $class;
+}
+
+1;
+
+=head1 NAME
+
+Test::Stream::Tester::Events - Event list used by L<Test::Stream::Tester>.
+
+=head1 DESCRIPTION
+
+L<Test::Stream::Tester> converts lists of events into instances of this object
+for use in various tools. You will probably never need to directly use this
+class.
+
+=head1 METHODS
+
+=over 4
+
+=item $events = $class->new(@EVENTS);
+
+Create a new instance from a list of events.
+
+=item $event = $events->next
+
+Get the next event.
+
+=item $event = $events->seek($type)
+
+Get the next event of the specific type (not a package name).
+
+=item $copy = $events->clone()
+
+Clone the events list object in its current state.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Tester/Events/Event.pm b/cpan/Test-Simple/lib/Test/Stream/Tester/Events/Event.pm
new file mode 100644
index 0000000000..f4265ad830
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Tester/Events/Event.pm
@@ -0,0 +1,199 @@
+package Test::Stream::Tester::Events::Event;
+use strict;
+use warnings;
+
+use Test::Stream::Carp qw/confess/;
+use Scalar::Util qw/reftype blessed/;
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+
+ my @orig = @_;
+
+ while (@_) {
+ my $field = shift;
+ my $val = shift;
+
+ if (exists $self->{$field}) {
+ use Data::Dumper;
+ print Dumper(@orig);
+ confess "'$field' specified more than once!";
+ }
+
+ if (my $type = reftype $val) {
+ if ($type eq 'ARRAY') {
+ $val = Test::Stream::Tester::Events->new(@$val)
+ unless grep { !blessed($_) || !$_->isa('Test::Stream::Event') } @$val;
+ }
+ elsif (blessed($val) && $val->isa('Test::Stream::Event')) {
+ $val = $class->new($val->summary);
+ }
+ }
+
+ $self->{$field} = $val;
+ }
+
+ return $self;
+}
+
+sub get {
+ my $self = shift;
+ my ($field) = @_;
+ return $self->{$field};
+}
+
+sub debug {
+ my $self = shift;
+
+ my $type = $self->get('type');
+ my $file = $self->get('file');
+ my $line = $self->get('line');
+
+ return "'$type' from $file line $line.";
+}
+
+1;
+
+=head1 NAME
+
+Test::Stream::Tester::Events::Event - L<Test::Stream::Tester> representation of
+an event.
+
+=head1 DESCRIPTION
+
+L<Test::Stream::Tester> often uses this clas to represent events in a way that
+is easier to validate.
+
+=head1 SYNOPSYS
+
+ use Test::Stream::Tester::Events::Event;
+
+ my $event = Test::Stream::Tester::Events::Event->new($e->summary);
+
+ # Print the file and line number where the event was generated
+ print "Debug: " . $event->debug . "\n";
+
+ # Get an event field value
+ my $val = $event->get($field);
+
+=head1 METHODS
+
+=over 4
+
+=item $event->get($field)
+
+Get the value of a specific event field. Fields are specific to event types.
+The fields are usually the result of calling C<< $e->summary >> on the original
+event.
+
+=item $event->debug
+
+Returns a string like this:
+
+ 'ok' from my_test.t line 42.
+
+Which lists the type of event, the file that generated, and the line number on
+which it was generated.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Tester/Grab.pm b/cpan/Test-Simple/lib/Test/Stream/Tester/Grab.pm
new file mode 100644
index 0000000000..bf2ab5ffcc
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Tester/Grab.pm
@@ -0,0 +1,215 @@
+package Test::Stream::Tester::Grab;
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+
+ my $self = bless {
+ events => [],
+ streams => [ Test::Stream->intercept_start ],
+ }, $class;
+
+ $self->{streams}->[0]->listen(
+ sub {
+ shift; # Stream
+ push @{$self->{events}} => @_;
+ }
+ );
+
+ return $self;
+}
+
+sub flush {
+ my $self = shift;
+ my $out = delete $self->{events};
+ $self->{events} = [];
+ return $out;
+}
+
+sub events {
+ my $self = shift;
+ # Copy
+ return [@{$self->{events}}];
+}
+
+sub finish {
+ my ($self) = @_; # Do not shift;
+ $_[0] = undef;
+
+ $self->{finished} = 1;
+ my ($remove) = $self->{streams}->[0];
+ Test::Stream->intercept_stop($remove);
+
+ return $self->flush;
+}
+
+sub DESTROY {
+ my $self = shift;
+ return if $self->{finished};
+ my ($remove) = $self->{streams}->[0];
+ Test::Stream->intercept_stop($remove);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Test::Stream::Tester::Grab - Object used to temporarily steal all events.
+
+=head1 DESCRIPTION
+
+Once created this object will intercept and stash all events sent to the shared
+L<Test::Stream> object. Once the object is destroyed events will once again be
+sent to the shared stream.
+
+=head1 SYNOPSYS
+
+ use Test::More;
+ use Test::Stream::Tester::Grab;
+
+ my $grab = Test::Stream::Tester::Grab->new();
+
+ # Generate some events, they are intercepted.
+ ok(1, "pass");
+ ok(0, "fail");
+
+ my $events_a = $grab->flush;
+
+ # Generate some more events, they are intercepted.
+ ok(1, "pass");
+ ok(0, "fail");
+
+ # Same as flush, except it destroys the grab object.
+ my $events_b = $grab->finish;
+
+After calling C<finish()> the grab object is destroyed and C<$grab> is set to
+undef. C<$events_a> is an arrayref with the first 2 events. C<$events_b> is an
+arrayref with the second 2 events.
+
+=head1 METHODS
+
+=over 4
+
+=item $grab = $class->new()
+
+Create a new grab object, immediately starts intercepting events.
+
+=item $ar = $grab->flush()
+
+Get an arrayref of all the events so far, clearing the grab objects internal
+list.
+
+=item $ar = $grab->events()
+
+Get an arrayref of all events so far, does not clear the internal list.
+
+=item $ar = $grab->finish()
+
+Get an arrayref of all the events, then destroy the grab object.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Threads.pm b/cpan/Test-Simple/lib/Test/Stream/Threads.pm
new file mode 100644
index 0000000000..e07c9cea6f
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Threads.pm
@@ -0,0 +1,163 @@
+package Test::Stream::Threads;
+use strict;
+use warnings;
+
+BEGIN {
+ use Config;
+ if( $Config{useithreads} && $INC{'threads.pm'} ) {
+ eval q|
+ sub get_tid { threads->tid() }
+ sub USE_THREADS() { 1 }
+ 1;
+ | || die $@;
+ }
+ else {
+ eval q|
+ sub get_tid() { 0 }
+ sub USE_THREADS() { 0 }
+ 1;
+ | || die $@;
+ }
+}
+
+use Test::Stream::Exporter;
+default_exports qw/get_tid USE_THREADS/;
+Test::Stream::Exporter->cleanup;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Threads - Tools for using threads with Test::Stream.
+
+=head1 DESCRIPTION
+
+This module provides some helpers for Test::Stream and Toolsets to use to
+determine if threading is in place. In most cases you will not need to use this
+module yourself.
+
+=head1 SYNOPSYS
+
+ use threads;
+ use Test::Stream::Threads;
+
+ if (USE_THREADS) {
+ my $tid = get_tid();
+ }
+
+=head1 EXPORTS
+
+=over 4
+
+=item USE_THREADS
+
+This is a constant, it is set to true when Test::Stream is aware of, and using, threads.
+
+=item get_tid
+
+This will return the id of the current thread when threads are enabled,
+otherwise it returns 0.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Toolset.pm b/cpan/Test-Simple/lib/Test/Stream/Toolset.pm
new file mode 100644
index 0000000000..74a66bd257
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Toolset.pm
@@ -0,0 +1,350 @@
+package Test::Stream::Toolset;
+use strict;
+use warnings;
+
+use Test::Stream::Context qw/context/;
+use Test::Stream::Meta qw/is_tester init_tester/;
+
+# Preload these so the autoload is not necessary
+use Test::Stream::Event::Bail;
+use Test::Stream::Event::Child;
+use Test::Stream::Event::Diag;
+use Test::Stream::Event::Finish;
+use Test::Stream::Event::Note;
+use Test::Stream::Event::Ok;
+use Test::Stream::Event::Plan;
+use Test::Stream::Event::Subtest;
+
+use Test::Stream::Exporter qw/import export_to default_exports/;
+default_exports qw/is_tester init_tester context/;
+Test::Stream::Exporter->cleanup();
+
+1;
+
+=head1 NAME
+
+Test::Stream::Toolset - Helper for writing testing tools
+
+=head1 DESCRIPTION
+
+This package provides you with tools to write testing tools. It makes your job
+of integrating with L<Test::Builder> and other testing tools much easier.
+
+=head1 SYNOPSYS
+
+ package My::Tester;
+ use strict;
+ use warnings;
+ use Test::Stream::Toolset;
+
+ # Optional, you can just use Exporter if you would like
+ use Test::Stream::Exporter;
+
+ # These can come from Test::More, so do not export them by default
+ # exports is the Test::Stream::Exporter equivilent to @EXPORT_OK
+ exports qw/context done_testing/;
+
+ # These are the API we want to provide, export them by default
+ # default_exports is the Test::Stream::Exporter equivilent to @EXPORT
+ default_exports qw/my_ok my_note/;
+
+ sub my_ok {
+ my ($test, $name) = @_;
+ my $ctx = context();
+
+ my @diag;
+ push @diag => "'$test' is not true!" unless $test;
+
+ $ctx->ok($test, $name, \@diag);
+
+ return $test ? 1 : 0; # Reduce to a boolean
+ }
+
+ sub my_note {
+ my ($msg) = @_;
+ my $ctx = context();
+
+ $ctx->note($msg);
+
+ return $msg;
+ }
+
+ sub done_testing {
+ my ($expected) = @_;
+ my $ctx = context();
+ $ctx->done_testing($expected);
+ }
+
+ 1;
+
+=head1 EXPORTS
+
+=over 4
+
+=item $ctx = context()
+
+The context() method is used to get the current context, generating one if
+necessary. The context object is an instance of L<Test::Stream::Context>, and
+is used to generate events suck as C<ok> and C<plan>. The context also knows
+what file+line errors should be reported at.
+
+B<WARNING:> Do not directly store the context in anything other than a lexical
+variable scoped to your function! As long as there are references to a context
+object, C<context()> will return that object. You want the object to be
+destroyed at the end of the current scope so that the next function you call
+can create a new one. If you need a copy of the context use
+C<< $ctx = $ctx->snapshot >>.
+
+=item $meta = init_tester($CLASS)
+
+This method can be used to initialize a class as a test class. In most cases
+you do not actually need to use this. If the class is already a tester this
+will return the existing meta object.
+
+=item $meta = is_tester($CLASS)
+
+This method can be used to check if an object is a tester. If the object is a
+tester it will return the meta object for the tester.
+
+=back
+
+=head1 GENERATING EVENTS
+
+Events are always generated via a context object. Whenever you load an
+L<Test::Stream::Event> class it will add a method to L<Test::Stream::Context>
+which can be used to fire off that type of event.
+
+The following event types are all loaded automatically by
+L<Test::Stream::Toolset>
+
+=over 4
+
+=item L<Test::Stream::Event::Ok>
+
+ $ctx->ok($bool, $name, \@diag)
+
+Ok events are your actual assertions. You assert that a condition is what you
+expect. It is recommended that you name your assertions. You can include an
+array of diag objects and/or diagniostics strings that will be printed to
+STDERR as comments in the event of a failure.
+
+=item L<Test::Stream::Event::Diag>
+
+ $ctx->diag($MESSAGE)
+
+Produce an independant diagnostics message.
+
+=item L<Test::Stream::Event::Note>
+
+ $ctx->note($MESSAGE)
+
+Produce a note, that is a message that is printed to STDOUT as a comment.
+
+=item L<Test::Stream::Event::Plan>
+
+ $ctx->plan($MAX, $DIRECTIVE, $REASON)
+
+This will set the plan. C<$MAX> should be the number of tests you expect to
+run. You may set this to 0 for some plan directives. Examples of directives are
+C<'skip_all'> and C<'no_plan'>. Some directives have an additional argument
+called C<$REASON> which is aptly named as the reason for the directive.
+
+=item L<Test::Stream::Event::Bail>
+
+ $ctx->bail($MESSAGE)
+
+In the event of a catostrophic failure that should terminate the test file, use
+this event to stop everything and print the reason.
+
+=item L<Test::Stream::Event::Finish>
+
+=item L<Test::Stream::Event::Child>
+
+=item L<Test::Stream::Event::Subtest>
+
+These are not intended for public use, but are documented for completeness.
+
+=back
+
+=head1 MODIFYING EVENTS
+
+If you want to make changes to event objects before they are processed, you can
+add a munger. The return from a munger is ignored, you must make your changes
+directly to the event object.
+
+ Test::Stream->shared->munge(sub {
+ my ($stream, $event) = @_;
+ ...
+ });
+
+B<Note:> every munger is called for every event of every type. There is also no
+way to remove a munger. For performance reasons it is best to only ever add one
+munger per toolset which dispatches according to events and state.
+
+=head1 LISTENING FOR EVENTS
+
+If you wish to know when an event has occured so that you can do something
+after it has been processed, you can add a listener. Your listener will be
+called for every single event that occurs, after it has been processed. The
+return from a listener is ignored.
+
+ Test::Stream->shared->listen(sub {
+ my ($stream, $event) = @_;
+ ...
+ });
+
+B<Note:> every listener is called for every event of every type. There is also no
+way to remove a listener. For performance reasons it is best to only ever add one
+listener per toolset which dispatches according to events and state.
+
+=head1 I WANT TO EMBED FUNCTIONALITY FROM TEST::MORE
+
+Take a look at L<Test::More::Tools> which provides an interfaces to the code in
+Test::More. You can use that library to produce booleans and diagnostics
+without actually triggering events, giving you the opportunity to generate your
+own.
+
+=head1 FROM TEST::BUILDER TO TEST::STREAM
+
+This is a list of things people used to override in Test::Builder, and the new
+API that should be used instead of overrides.
+
+=over 4
+
+=item ok
+
+=item note
+
+=item diag
+
+=item plan
+
+In the past people would override these methods on L<Test::Builder>.
+L<Test::Stream> now provides a proper API for handling all event types.
+
+Anything that used to be done via overrides can now be done using
+c<Test::Stream->shared->listen(sub { ... })> and
+C<Test::Stream->shared->munge(sub { ... })>, which are documented above.
+
+=item done_testing
+
+In the past people have overriden C<done_testing()> to insert some code between
+the last test and the final plan. The proper way to do this now is with a
+follow_up hook.
+
+ Test::Stream->shared->follow_up(sub {
+ my ($context) = @_;
+ ...
+ });
+
+There are multiple ways that follow_ups will be triggered, but they are
+guarenteed to only be called once, at the end of testing. This will either be
+the start of C<done_testing()>, or an END block called after your tests are
+complete.
+
+=back
+
+=head1 HOW DO I TEST MY TEST TOOLS?
+
+See L<Test::Stream::Tester>. This library gives you all the tools you need to
+test your testing tools.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Stream/Util.pm b/cpan/Test-Simple/lib/Test/Stream/Util.pm
new file mode 100644
index 0000000000..0ba9354ebb
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/Util.pm
@@ -0,0 +1,331 @@
+package Test::Stream::Util;
+use strict;
+use warnings;
+
+use Scalar::Util qw/reftype blessed/;
+use Test::Stream::Exporter qw/import export_to exports/;
+use Test::Stream::Carp qw/croak/;
+
+exports qw{
+ try protect spoof is_regex is_dualvar
+ unoverload unoverload_str unoverload_num
+ translate_filename
+};
+
+Test::Stream::Exporter->cleanup();
+
+sub protect(&) {
+ my $code = shift;
+
+ my ($ok, $error);
+ {
+ local ($@, $!);
+ $ok = eval { $code->(); 1 } || 0;
+ $error = $@ || "Error was squashed!\n";
+ }
+ die $error unless $ok;
+ return $ok;
+}
+
+sub try(&) {
+ my $code = shift;
+ my $error;
+ my $ok;
+
+ {
+ local ($@, $!, $SIG{__DIE__});
+ $ok = eval { $code->(); 1 } || 0;
+ unless($ok) {
+ $error = $@ || "Error was squashed!\n";
+ }
+ }
+
+ return wantarray ? ($ok, $error) : $ok;
+}
+
+sub spoof {
+ my ($call, $code, @args) = @_;
+
+ croak "The first argument to spoof must be an arrayref with package, filename, and line."
+ unless $call && @$call == 3;
+
+ croak "The second argument must be a string to run."
+ if ref $code;
+
+ my $error;
+ my $ok;
+
+ {
+ local ($@, $!);
+ $ok = eval <<" EOT" || 0;
+package $call->[0];
+#line $call->[2] "$call->[1]"
+$code;
+1;
+ EOT
+ unless($ok) {
+ $error = $@ || "Error was squashed!\n";
+ }
+ }
+
+ return wantarray ? ($ok, $error) : $ok;
+}
+
+sub is_regex {
+ my ($pattern) = @_;
+
+ return undef unless defined $pattern;
+
+ return $pattern if defined &re::is_regexp
+ && re::is_regexp($pattern);
+
+ my $type = reftype($pattern) || '';
+
+ return $pattern if $type =~ m/^regexp?$/i;
+ return $pattern if $type eq 'SCALAR' && $pattern =~ m/^\(\?.+:.*\)$/s;
+ return $pattern if !$type && $pattern =~ m/^\(\?.+:.*\)$/s;
+
+ my ($re, $opts);
+
+ if ($pattern =~ m{^ /(.*)/ (\w*) $ }sx) {
+ protect { ($re, $opts) = ($1, $2) };
+ }
+ elsif ($pattern =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx) {
+ protect { ($re, $opts) = ($2, $3) };
+ }
+ else {
+ return;
+ }
+
+ return length $opts ? "(?$opts)$re" : $re;
+}
+
+sub unoverload_str { unoverload(q[""], @_) }
+
+sub unoverload_num {
+ unoverload('0+', @_);
+
+ for my $val (@_) {
+ next unless is_dualvar($$val);
+ $$val = $$val + 0;
+ }
+
+ return;
+}
+
+# This is a hack to detect a dualvar such as $!
+sub is_dualvar($) {
+ my($val) = @_;
+
+ # Objects are not dualvars.
+ return 0 if ref $val;
+
+ no warnings 'numeric';
+ my $numval = $val + 0;
+ return ($numval != 0 and $numval ne $val ? 1 : 0);
+}
+
+## If Scalar::Util is new enough use it
+# This breaks cmp_ok diagnostics
+#if (my $sub = Scalar::Util->can('isdual')) {
+# no warnings 'redefine';
+# *is_dualvar = $sub;
+#}
+
+sub unoverload {
+ my $type = shift;
+
+ protect { require overload };
+
+ for my $thing (@_) {
+ if (blessed $$thing) {
+ if (my $string_meth = overload::Method($$thing, $type)) {
+ $$thing = $$thing->$string_meth();
+ }
+ }
+ }
+}
+
+my $NORMALIZE = undef;
+sub translate_filename {
+ my ($encoding, $orig) = @_;
+
+ return $orig if $encoding eq 'legacy';
+
+ my $decoded;
+ require Encode;
+ try { $decoded = Encode::decode($encoding, "$orig", Encode::FB_CROAK()) };
+ return $orig unless $decoded;
+
+ unless (defined $NORMALIZE) {
+ $NORMALIZE = try { require Unicode::Normalize; 1 };
+ $NORMALIZE ||= 0;
+ }
+ $decoded = Unicode::Normalize::NFKC($decoded) if $NORMALIZE;
+ return $decoded || $orig;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Stream::Util - Tools used by Test::Stream and friends.
+
+=head1 DESCRIPTION
+
+Collection of tools used by L<Test::Stream> and friends.
+
+=head1 EXPORTS
+
+=over 4
+
+=item $success = try { ... }
+
+=item ($success, $error) = try { ... }
+
+Eval the codeblock, return success or failure, and optionally the error
+message. This code protects $@ and $!, they will be restored by the end of the
+run. This code also temporarily blocks $SIG{DIE} handlers.
+
+=item protect { ... }
+
+Similar to try, except that it does not catch exceptions. The idea here is to
+protect $@ and $! from changes. $@ and $! will be restored to whatever they
+were before the run so long as it is successful. If the run fails $! will still
+be restored, but $@ will contain the exception being thrown.
+
+=item spoof([$package, $file, $line], "Code String", @args)
+
+Eval the string provided as the second argument pretending to be the specified
+package, file, and line number. The main purpose of this is to have warnings
+and exceptions be thrown from the desired context.
+
+Additional arguments will be added to an C<@args> variable that is available to
+you inside your code string.
+
+=item $usable_pattern = is_regex($PATTERN)
+
+Check of the specified argument is a regex. This is mainly important in older
+perls where C<qr//> did not work the way it does now.
+
+=item is_dualvar
+
+Do not use this, use Scalar::Util::isdual instead. This is kept around for
+legacy support.
+
+=item unoverload
+
+=item unoverload_str
+
+=item unoverload_num
+
+Legacy tools for unoverloading things.
+
+=item $proper = translate_filename($encoding, $raw)
+
+Translate filenames from whatever perl has them stored as into the proper,
+specified, encoding.
+
+=back
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm
new file mode 100644
index 0000000000..25a62a9424
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Tester.pm
@@ -0,0 +1,769 @@
+use strict;
+
+package Test::Tester;
+
+# Turn this back on later
+#warn "Test::Tester is deprecated, see Test::Stream::Tester\n";
+
+use Test::Builder 1.301001;
+use Test::Stream::Toolset;
+use Test::More::Tools;
+use Test::Stream qw/-internal STATE_LEGACY/;
+use Test::Tester::Capture;
+
+require Exporter;
+
+use vars qw( @ISA @EXPORT $VERSION );
+
+our $VERSION = '1.301001_063';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+@EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
+@ISA = qw( Exporter );
+
+my $want_space = $ENV{TESTTESTERSPACE};
+
+sub show_space {
+ $want_space = 1;
+}
+
+my $colour = '';
+my $reset = '';
+
+if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOUR}) {
+ if (eval "require Term::ANSIColor") {
+ my ($f, $b) = split(",", $want_colour);
+ $colour = Term::ANSIColor::color($f) . Term::ANSIColor::color("on_$b");
+ $reset = Term::ANSIColor::color("reset");
+ }
+
+}
+
+my $capture = Test::Tester::Capture->new;
+sub capture { $capture }
+
+sub find_depth {
+ my ($start, $end);
+ my $l = 1;
+ while (my @call = caller($l++)) {
+ $start = $l if $call[3] =~ m/^Test::Builder::(ok|skip|todo_skip)$/;
+ next unless $start;
+ next unless $call[3] eq 'Test::Tester::run_tests';
+ $end = $l;
+ last;
+ }
+
+ return $Test::Builder::Level + 1 unless defined $start && defined $end;
+ # 2 the eval and the anon sub
+ return $end - $start - 2;
+}
+
+require Test::Stream::Event::Ok;
+my $META = Test::Stream::ArrayBase::Meta->get('Test::Stream::Event::Ok');
+my $idx = $META->{index} + 1;
+
+sub run_tests {
+ my $test = shift;
+
+ my $cstream;
+ if ($capture) {
+ $cstream = $capture->{stream};
+ }
+
+ my ($stream, $old) = Test::Stream->intercept_start($cstream);
+ $stream->set_use_legacy(1);
+ $stream->state->[-1] = [0, 0, undef, 1];
+ $stream->munge(sub {
+ my ($stream, $e) = @_;
+ $e->[$idx] = find_depth() - $Test::Builder::Level;
+ $e->[$idx+1] = $Test::Builder::Level;
+ require Carp;
+ $e->[$idx + 2] = Carp::longmess();
+ });
+
+ my $level = $Test::Builder::Level;
+
+ my @out;
+ my $prem = "";
+
+ my $ok = eval {
+ $test->();
+
+ for my $e (@{$stream->state->[-1]->[STATE_LEGACY]}) {
+ if ($e->isa('Test::Stream::Event::Ok')) {
+ push @out => $e->to_legacy;
+ $out[-1]->{name} = '' unless defined $out[-1]->{name};
+ $out[-1]->{diag} ||= "";
+ $out[-1]->{depth} = $e->[$idx];
+ for my $d (@{$e->diag || []}) {
+ next if $d->message =~ m{Failed (\(TODO\) )?test (.*\n\s*)?at .* line \d+\.};
+ next if $d->message =~ m{You named your test '.*'\. You shouldn't use numbers for your test names};
+ chomp(my $msg = $d->message);
+ $msg .= "\n";
+ $out[-1]->{diag} .= $msg;
+ }
+ }
+ elsif ($e->isa('Test::Stream::Event::Diag')) {
+ chomp(my $msg = $e->message);
+ $msg .= "\n";
+ if (!@out) {
+ $prem .= $msg;
+ next;
+ }
+ next if $msg =~ m{Failed test .*\n\s*at .* line \d+\.};
+ $out[-1]->{diag} .= $msg;
+ }
+ }
+
+ 1;
+ };
+ my $err = $@;
+
+ $stream->state->[-1] = [0, 0, undef, 1];
+
+ Test::Stream->intercept_stop($stream);
+
+ die $err unless $ok;
+
+ return ($prem, @out);
+}
+
+sub check_test {
+ my $test = shift;
+ my $expect = shift;
+ my $name = shift;
+ $name = "" unless defined($name);
+
+ @_ = ($test, [$expect], $name);
+ goto &check_tests;
+}
+
+sub check_tests {
+ my $test = shift;
+ my $expects = shift;
+ my $name = shift;
+ $name = "" unless defined($name);
+
+ my ($prem, @results) = eval { run_tests($test, $name) };
+
+ my $ctx = context();
+
+ my $ok = !$@;
+ $ctx->ok($ok, "Test '$name' completed");
+ $ctx->diag($@) unless $ok;
+
+ $ok = !length($prem);
+ $ctx->ok($ok, "Test '$name' no premature diagnostication");
+ $ctx->diag("Before any testing anything, your tests said\n$prem") unless $ok;
+
+ cmp_results(\@results, $expects, $name);
+ return ($prem, @results);
+}
+
+sub cmp_field {
+ my ($result, $expect, $field, $desc) = @_;
+
+ my $ctx = context();
+ if (defined $expect->{$field}) {
+ my ($ok, @diag) = Test::More::Tools->is_eq(
+ $result->{$field},
+ $expect->{$field},
+ );
+ $ctx->ok($ok, "$desc compare $field");
+ }
+}
+
+sub cmp_result {
+ my ($result, $expect, $name) = @_;
+
+ my $ctx = context();
+
+ my $sub_name = $result->{name};
+ $sub_name = "" unless defined($name);
+
+ my $desc = "subtest '$sub_name' of '$name'";
+
+ {
+ cmp_field($result, $expect, "ok", $desc);
+
+ cmp_field($result, $expect, "actual_ok", $desc);
+
+ cmp_field($result, $expect, "type", $desc);
+
+ cmp_field($result, $expect, "reason", $desc);
+
+ cmp_field($result, $expect, "name", $desc);
+ }
+
+ # if we got no depth then default to 1
+ my $depth = 1;
+ if (exists $expect->{depth}) {
+ $depth = $expect->{depth};
+ }
+
+ # if depth was explicitly undef then don't test it
+ if (defined $depth) {
+ $ctx->ok(1, "depth checking is deprecated, dummy pass result...");
+ }
+
+ if (defined(my $exp = $expect->{diag})) {
+ # if there actually is some diag then put a \n on the end if it's not
+ # there already
+
+ $exp .= "\n" if (length($exp) and $exp !~ /\n$/);
+ my $ok = $result->{diag} eq $exp;
+ $ctx->ok(
+ $ok,
+ "subtest '$sub_name' of '$name' compare diag"
+ );
+ unless($ok) {
+ my $got = $result->{diag};
+ my $glen = length($got);
+ my $elen = length($exp);
+ for ($got, $exp) {
+ my @lines = split("\n", $_);
+ $_ = join(
+ "\n",
+ map {
+ if ($want_space) {
+ $_ = $colour . escape($_) . $reset;
+ }
+ else {
+ "'$colour$_$reset'";
+ }
+ } @lines
+ );
+ }
+
+ $ctx->diag(<<EOM);
+Got diag ($glen bytes):
+$got
+Expected diag ($elen bytes):
+$exp
+EOM
+
+ }
+ }
+}
+
+sub escape {
+ my $str = shift;
+ my $res = '';
+ for my $char (split("", $str)) {
+ my $c = ord($char);
+ if (($c > 32 and $c < 125) or $c == 10) {
+ $res .= $char;
+ }
+ else {
+ $res .= sprintf('\x{%x}', $c);
+ }
+ }
+ return $res;
+}
+
+sub cmp_results {
+ my ($results, $expects, $name) = @_;
+
+ my $ctx = context();
+
+ my ($ok, @diag) = Test::More::Tools->is_num(scalar @$results, scalar @$expects, "Test '$name' result count");
+ $ctx->ok($ok, @diag);
+
+ for (my $i = 0; $i < @$expects; $i++) {
+ my $expect = $expects->[$i];
+ my $result = $results->[$i];
+
+ cmp_result($result, $expect, $name);
+ }
+}
+
+######## nicked from Test::More
+sub import {
+ my $class = shift;
+ my @plan = @_;
+
+ my $caller = caller;
+ my $ctx = context();
+
+ my @imports = ();
+ foreach my $idx (0 .. $#plan) {
+ if ($plan[$idx] eq 'import') {
+ my ($tag, $imports) = splice @plan, $idx, 2;
+ @imports = @$imports;
+ last;
+ }
+ }
+
+ my ($directive, $arg) = @plan;
+ if ($directive eq 'tests') {
+ $ctx->plan($arg);
+ }
+ elsif ($directive) {
+ $ctx->plan(0, $directive, $arg);
+ }
+
+ $class->_export_to_level(1, __PACKAGE__, @imports);
+}
+
+sub _export_to_level {
+ my $pkg = shift;
+ my $level = shift;
+ (undef) = shift; # redundant arg
+ my $callpkg = caller($level);
+ $pkg->export($callpkg, @_);
+}
+
+############
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Tester - *DEPRECATED* Ease testing test modules built with Test::Builder
+
+=head1 DEPRECATED
+
+See L<Test::Stream::Tester> for a modern and maintained alternative.
+
+=head1 SYNOPSIS
+
+ use Test::Tester tests => 6;
+
+ use Test::MyStyle;
+
+ check_test(
+ sub {
+ is_mystyle_eq("this", "that", "not eq");
+ },
+ {
+ ok => 0, # expect this to fail
+ name => "not eq",
+ diag => "Expected: 'this'\nGot: 'that'",
+ }
+ );
+
+or
+
+ use Test::Tester;
+
+ use Test::More tests => 3;
+ use Test::MyStyle;
+
+ my ($premature, @results) = run_tests(
+ sub {
+ is_database_alive("dbname");
+ }
+ );
+
+ # now use Test::More::like to check the diagnostic output
+
+ like($results[0]->{diag}, "/^Database ping took \\d+ seconds$"/, "diag");
+
+=head1 DESCRIPTION
+
+If you have written a test module based on Test::Builder then Test::Tester
+allows you to test it with the minimum of effort.
+
+=head1 HOW TO USE (THE EASY WAY)
+
+From version 0.08 Test::Tester no longer requires you to included anything
+special in your test modules. All you need to do is
+
+ use Test::Tester;
+
+in your test script B<before> any other Test::Builder based modules and away
+you go.
+
+Other modules based on Test::Builder can be used to help with the
+testing. In fact you can even use functions from your module to test
+other functions from the same module (while this is possible it is
+probably not a good idea, if your module has bugs, then
+using it to test itself may give the wrong answers).
+
+The easiest way to test is to do something like
+
+ check_test(
+ sub { is_mystyle_eq("this", "that", "not eq") },
+ {
+ ok => 0, # we expect the test to fail
+ name => "not eq",
+ diag => "Expected: 'this'\nGot: 'that'",
+ }
+ );
+
+this will execute the is_mystyle_eq test, capturing it's results and
+checking that they are what was expected.
+
+You may need to examine the test results in a more flexible way, for
+example, the diagnostic output may be quite long or complex or it may involve
+something that you cannot predict in advance like a timestamp. In this case
+you can get direct access to the test results:
+
+ my ($premature, @results) = run_tests(
+ sub {
+ is_database_alive("dbname");
+ }
+ );
+
+ like($result[0]->{diag}, "/^Database ping took \\d+ seconds$"/, "diag");
+
+
+We cannot predict how long the database ping will take so we use
+Test::More's like() test to check that the diagnostic string is of the right
+form.
+
+=head1 HOW TO USE (THE HARD WAY)
+
+I<This is here for backwards compatibility only>
+
+Make your module use the Test::Tester::Capture object instead of the
+Test::Builder one. How to do this depends on your module but assuming that
+your module holds the Test::Builder object in $Test and that all your test
+routines access it through $Test then providing a function something like this
+
+ sub set_builder
+ {
+ $Test = shift;
+ }
+
+should allow your test scripts to do
+
+ Test::YourModule::set_builder(Test::Tester->capture);
+
+and after that any tests inside your module will captured.
+
+=head1 TEST EVENTS
+
+The result of each test is captured in a hash. These hashes are the same as
+the hashes returned by Test::Builder->details but with a couple of extra
+fields.
+
+These fields are documented in L<Test::Builder> in the details() function
+
+=over 2
+
+=item ok
+
+Did the test pass?
+
+=item actual_ok
+
+Did the test really pass? That is, did the pass come from
+Test::Builder->ok() or did it pass because it was a TODO test?
+
+=item name
+
+The name supplied for the test.
+
+=item type
+
+What kind of test? Possibilities include, skip, todo etc. See
+L<Test::Builder> for more details.
+
+=item reason
+
+The reason for the skip, todo etc. See L<Test::Builder> for more details.
+
+=back
+
+These fields are exclusive to Test::Tester.
+
+=over 2
+
+=item diag
+
+Any diagnostics that were output for the test. This only includes
+diagnostics output B<after> the test result is declared.
+
+Note that Test::Builder ensures that any diagnostics end in a \n and
+it in earlier versions of Test::Tester it was essential that you have
+the final \n in your expected diagnostics. From version 0.10 onwards,
+Test::Tester will add the \n if you forgot it. It will not add a \n if
+you are expecting no diagnostics. See below for help tracking down
+hard to find space and tab related problems.
+
+=item depth
+
+B<Note:> Depth checking is disabled on newer versions of Test::Builder which no
+longer uses $Test::Builder::Level. In these versions this will simple produce a
+dummy true result.
+
+This allows you to check that your test module is setting the correct value
+for $Test::Builder::Level and thus giving the correct file and line number
+when a test fails. It is calculated by looking at caller() and
+$Test::Builder::Level. It should count how many subroutines there are before
+jumping into the function you are testing. So for example in
+
+ run_tests( sub { my_test_function("a", "b") } );
+
+the depth should be 1 and in
+
+ sub deeper { my_test_function("a", "b") }
+
+ run_tests(sub { deeper() });
+
+depth should be 2, that is 1 for the sub {} and one for deeper(). This
+might seem a little complex but if your tests look like the simple
+examples in this doc then you don't need to worry as the depth will
+always be 1 and that's what Test::Tester expects by default.
+
+B<Note>: if you do not specify a value for depth in check_test() then it
+automatically compares it against 1, if you really want to skip the depth
+test then pass in undef.
+
+B<Note>: depth will not be correctly calculated for tests that run from a
+signal handler or an END block or anywhere else that hides the call stack.
+
+=back
+
+Some of Test::Tester's functions return arrays of these hashes, just
+like Test::Builder->details. That is, the hash for the first test will
+be array element 1 (not 0). Element 0 will not be a hash it will be a
+string which contains any diagnostic output that came before the first
+test. This should usually be empty, if it's not, it means something
+output diagnostics before any test results showed up.
+
+=head1 SPACES AND TABS
+
+Appearances can be deceptive, especially when it comes to emptiness. If you
+are scratching your head trying to work out why Test::Tester is saying that
+your diagnostics are wrong when they look perfectly right then the answer is
+probably whitespace. From version 0.10 on, Test::Tester surrounds the
+expected and got diag values with single quotes to make it easier to spot
+trailing whitesapce. So in this example
+
+ # Got diag (5 bytes):
+ # 'abcd '
+ # Expected diag (4 bytes):
+ # 'abcd'
+
+it is quite clear that there is a space at the end of the first string.
+Another way to solve this problem is to use colour and inverse video on an
+ANSI terminal, see below COLOUR below if you want this.
+
+Unfortunately this is sometimes not enough, neither colour nor quotes will
+help you with problems involving tabs, other non-printing characters and
+certain kinds of problems inherent in Unicode. To deal with this, you can
+switch Test::Tester into a mode whereby all "tricky" characters are shown as
+\{xx}. Tricky characters are those with ASCII code less than 33 or higher
+than 126. This makes the output more difficult to read but much easier to
+find subtle differences between strings. To turn on this mode either call
+show_space() in your test script or set the TESTTESTERSPACE environment
+variable to be a true value. The example above would then look like
+
+ # Got diag (5 bytes):
+ # abcd\x{20}
+ # Expected diag (4 bytes):
+ # abcd
+
+=head1 COLOUR
+
+If you prefer to use colour as a means of finding tricky whitespace
+characters then you can set the TESTTESTCOLOUR environment variable to a
+comma separated pair of colours, the first for the foreground, the second
+for the background. For example "white,red" will print white text on a red
+background. This requires the Term::ANSIColor module. You can specify any
+colour that would be acceptable to the Term::ANSIColor::color function.
+
+If you spell colour differently, that's no problem. The TESTTESTERCOLOR
+variable also works (if both are set then the British spelling wins out).
+
+=head1 EXPORTED FUNCTIONS
+
+=head3 ($premature, @results) = run_tests(\&test_sub)
+
+\&test_sub is a reference to a subroutine.
+
+run_tests runs the subroutine in $test_sub and captures the results of any
+tests inside it. You can run more than 1 test inside this subroutine if you
+like.
+
+$premature is a string containing any diagnostic output from before
+the first test.
+
+@results is an array of test result hashes.
+
+=head3 cmp_result(\%result, \%expect, $name)
+
+\%result is a ref to a test result hash.
+
+\%expect is a ref to a hash of expected values for the test result.
+
+cmp_result compares the result with the expected values. If any differences
+are found it outputs diagnostics. You may leave out any field from the
+expected result and cmp_result will not do the comparison of that field.
+
+=head3 cmp_results(\@results, \@expects, $name)
+
+\@results is a ref to an array of test results.
+
+\@expects is a ref to an array of hash refs.
+
+cmp_results checks that the results match the expected results and if any
+differences are found it outputs diagnostics. It first checks that the
+number of elements in \@results and \@expects is the same. Then it goes
+through each result checking it against the expected result as in
+cmp_result() above.
+
+=head3 ($premature, @results) = check_tests(\&test_sub, \@expects, $name)
+
+\&test_sub is a reference to a subroutine.
+
+\@expect is a ref to an array of hash refs which are expected test results.
+
+check_tests combines run_tests and cmp_tests into a single call. It also
+checks if the tests died at any stage.
+
+It returns the same values as run_tests, so you can further examine the test
+results if you need to.
+
+=head3 ($premature, @results) = check_test(\&test_sub, \%expect, $name)
+
+\&test_sub is a reference to a subroutine.
+
+\%expect is a ref to an hash of expected values for the test result.
+
+check_test is a wrapper around check_tests. It combines run_tests and
+cmp_tests into a single call, checking if the test died. It assumes
+that only a single test is run inside \&test_sub and include a test to
+make sure this is true.
+
+It returns the same values as run_tests, so you can further examine the test
+results if you need to.
+
+=head3 show_space()
+
+Turn on the escaping of characters as described in the SPACES AND TABS
+section.
+
+=head1 HOW IT WORKS
+
+Normally, a test module (let's call it Test:MyStyle) calls
+Test::Builder->new to get the Test::Builder object. Test::MyStyle calls
+methods on this object to record information about test results. When
+Test::Tester is loaded, it replaces Test::Builder's new() method with one
+which returns a Test::Tester::Delegate object. Most of the time this object
+behaves as the real Test::Builder object. Any methods that are called are
+delegated to the real Test::Builder object so everything works perfectly.
+However once we go into test mode, the method calls are no longer passed to
+the real Test::Builder object, instead they go to the Test::Tester::Capture
+object. This object seems exactly like the real Test::Builder object,
+except, instead of outputting test results and diagnostics, it just records
+all the information for later analysis.
+
+=head1 CAVEATS
+
+Support for calling Test::Builder->note is minimal. It's implemented
+as an empty stub, so modules that use it will not crash but the calls
+are not recorded for testing purposes like the others. Patches
+welcome.
+
+=head1 SEE ALSO
+
+L<Test::Builder> the source of testing goodness. L<Test::Builder::Tester>
+for an alternative approach to the problem tackled by Test::Tester -
+captures the strings output by Test::Builder. This means you cannot get
+separate access to the individual pieces of information and you must predict
+B<exactly> what your test will output.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Tester/Capture.pm b/cpan/Test-Simple/lib/Test/Tester/Capture.pm
new file mode 100644
index 0000000000..d63fc8d556
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Tester/Capture.pm
@@ -0,0 +1,159 @@
+package Test::Tester::Capture;
+use strict;
+use warnings;
+
+use base 'Test::Builder';
+use Test::Stream qw/-internal STATE_LEGACY/;
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::create(@_);
+ $self->{stream}->set_use_tap(0);
+ $self->{stream}->set_use_legacy(1);
+ return $self;
+}
+
+sub details {
+ my $self = shift;
+
+ my $prem;
+ my @out;
+ for my $e (@{$self->{stream}->state->[-1]->[STATE_LEGACY]}) {
+ if ($e->isa('Test::Stream::Event::Ok')) {
+ push @out => $e->to_legacy;
+ $out[-1]->{diag} ||= "";
+ $out[-1]->{depth} = $e->level;
+ for my $d (@{$e->diag || []}) {
+ next if $d->message =~ m{Failed test .*\n\s*at .* line \d+\.};
+ chomp(my $msg = $d->message);
+ $msg .= "\n";
+ $out[-1]->{diag} .= $msg;
+ }
+ }
+ elsif ($e->isa('Test::Stream::Event::Diag')) {
+ chomp(my $msg = $e->message);
+ $msg .= "\n";
+ if (!@out) {
+ $prem .= $msg;
+ next;
+ }
+ next if $msg =~ m{Failed test .*\n\s*at .* line \d+\.};
+ $out[-1]->{diag} .= $msg;
+ }
+ }
+
+ return ($prem, @out) if $prem;
+ return @out;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::Tester::Capture - Capture module for TesT::Tester
+
+=head1 DESCRIPTION
+
+Legacy support for Test::Tester.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Tutorial/WritingTests.pod b/cpan/Test-Simple/lib/Test/Tutorial/WritingTests.pod
new file mode 100644
index 0000000000..45713fbaad
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Tutorial/WritingTests.pod
@@ -0,0 +1,198 @@
+=pod
+
+=head1 NAME
+
+Test::Tutorial::WritingTests - A Complete Introduction to writing tests
+
+=head1 What are tests?
+
+Tests are code that verifies other code produces the expected output for a
+given input. An example may help:
+
+ # This code will die if math doesbn't work.
+ die "Math is broken" unless 1 + 1 == 2;
+
+However it is better to use a framework intended for testing:
+
+ ok( 1 + 1 == 2, "Math Works" );
+
+This will tell you if the test passes or fails, and will give you extra
+information like the name of the test, and what line it was written on if it
+fails.
+
+=head1 Simple example.
+
+ use Test::More;
+
+ ok( 1, "1 is true, this test will pass" );
+ ok( 0, "0 is false, this test will fail" );
+
+ is( 1 + 1, 2, "1 + 1 == 2" );
+
+ my @array = first_3_numbers();
+
+ is_deeply(
+ \@array,
+ [ 1, 2, 3 ],
+ "function returned an array of 3 numbers"
+ );
+
+ # When you are done, call this to satisfy the plan
+ done_testing
+
+See L<Test::More> for C<ok()>, C<is()>, C<is_deeply()>, and several other
+useful tools.
+
+=head1 What is a plan?
+
+You need to declare how many tests should be seen, this is to ensure your test
+does not die partway through. There are 2 ways to declare a plan, 1 way to
+decline to make a plan, and a way to skip everything.
+
+=over 4
+
+=item done_testing
+
+ use Test::More;
+
+ ok(1, "pass");
+
+ done_testing;
+
+Using done_testing means you do not need to update the plan every time you
+change your test script.
+
+=item Test count
+
+At import:
+
+ use Test::More tests => 1;
+ ok(1, "pass");
+
+Plan on its own:
+
+ use Test::More;
+ plan tests => 1;
+ ok(1, "pass");
+
+=item No Plan
+
+ use Test::More 'no_plan';
+
+No plan, no way to verify everything ran.
+
+=item skip_all
+
+ use Test::More skip_all => "We won't run these now";
+
+Just don't do anything.
+
+=back
+
+=head1 See Also
+
+L<Test::More>
+
+=head1 Writing tools.
+
+See L<Test::Tutorial::WritingTools>
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/Tutorial/WritingTools.pod b/cpan/Test-Simple/lib/Test/Tutorial/WritingTools.pod
new file mode 100644
index 0000000000..26f4d370a6
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Tutorial/WritingTools.pod
@@ -0,0 +1,295 @@
+=pod
+
+=head1 NAME
+
+Test::Tutorial::WritingTools - How to write testing tools.
+
+=head1 Examples
+
+=over 4
+
+=item Complete Example
+
+ package My::Tool;
+ use strict;
+ use warnings;
+
+ use Test::Stream::Toolset;
+ use Test::Stream::Exporter;
+
+ # Export 'validate_widget' by default.
+ default_exports qw/validate_widget/;
+
+ sub validate_widget {
+ my ($widget, $produces, $name) = @_;
+ my $ctx = context(); # Do this early as possible
+
+ my $value = $widget->produce;
+ my $ok = $value eq $produces;
+
+ if ($ok) {
+ # On success generate an ok event
+ $ctx->ok($ok, $name);
+ }
+ else {
+ # On failure generate an OK event with some diagnostics
+ $ctx->ok($ok, $name, ["Widget produced '$value'\n Wanted '$produces'"]);
+ }
+
+ # It is usually polite to return a true/false value.
+ return $ok ? 1 : 0;
+ }
+
+ 1;
+
+=item Alternate using Exporter.pm
+
+ package My::Tool;
+ use strict;
+ use warnings;
+
+ use Test::Stream::Toolset;
+
+ # Export 'validate_widget' by default.
+ use base 'Exporter';
+ our @EXPORT = qw/validate_widget/;
+
+ sub validate_widget {
+ my ($widget, $produces, $name) = @_;
+ my $ctx = context(); # Do this early as possible
+
+ my $value = $widget->produce;
+ my $ok = $value eq $produces;
+
+ if ($ok) {
+ # On success generate an ok event
+ $ctx->ok($ok, $name);
+ }
+ else {
+ # On failure generate an OK event with some diagnostics
+ $ctx->ok($ok, $name, ["Widget produced '$value'\n Wanted '$produces'"]);
+ }
+
+ # It is usually polite to return a true/false value.
+ return $ok ? 1 : 0;
+ }
+
+ 1;
+
+=back
+
+=head2 Explanation
+
+L<Test::Stream> is event based. Whenever you want to produce a result you will
+generate an event for it. The most common event is L<Test::Stream::Event::Ok>.
+Events require some extra information such as where and how they were produced.
+In general you do not need to worry about these extra details, they can be
+filled in by C<Test::Stream::Context>.
+
+To get a context object you call C<context()> which can be imported from
+L<Test::Stream::Context> itself, or from L<Test::Stream::Toolset>. Once you
+have a context object you can ask it to issue events for you. All event types
+C<Test::Stream::Event::*> get helper methods on the context object.
+
+=head2 IMPORTANT NOTE ON CONTEXTS
+
+The context object has some magic to it. Essentially it is a semi-singleton.
+That is if you generate a context object in one place, then try to generate
+another one in another place, you will just get the first one again so long as
+it still has a reference. If however the first one has fallen out of scope or
+been undefined, a new context is generated.
+
+The idea here is that if you nest functions that use contexts, all levels of
+depth will get the same initial context. On the other hand 2 functions run in
+sequence will get independant context objects. What this means is that you
+should NEVER store a context object in a package variable or object attribute.
+You should also never assign it to a variable in a higher scope.
+
+=head1 Nesting calls to other tools
+
+ use Test::More;
+ use Test::Stream::Toolset;
+
+ sub compound_check {
+ my ($object, $name) = @_;
+
+ # Grab the context now for nested tools to find
+ my $ctx = context;
+
+ my $ok = $object ? 1 : 0;
+ $ok &&= isa_ok($object, 'Some::Class');
+ $ok &&= can_ok($object, qw/foo bar baz/);
+ $ok &&= is($object->foo, 'my foo', $name);
+
+ $ctx->ok($ok, $name, $ok ? () : ['Not all object checks passed!']);
+
+ return $ok;
+ }
+
+ 1;
+
+Nesting tools just works as expected so long as you grab the context BEFORE you
+call them. Errors will be reported to the correct file and line number.
+
+=head1 Useful toolsets to look at
+
+=over 4
+
+=item L<Test::More::Tools>
+
+This is the collection of tools used by L<Test::More> under the hood. You can
+use these instead of L<Test::More> exports to duplicate functionality without
+generating extra events.
+
+=back
+
+=head1 Available Events
+
+Anyone can add an event by shoving it in the C<Test::Stream::Event::*>
+namespace. It will autoload if C<< $context->event_name >> is called. But here
+is the list of events that come with L<Test::Stream>.
+
+=over 4
+
+=item L<Test::Stream::Event::Ok>
+
+ $ctx->ok($bool, $name);
+ $ctx->ok($bool, $name, \@diag);
+
+Generate an Ok event.
+
+=item L<Test::Stream::Event::Diag>
+
+ $ctx->diag("Diag Message");
+
+Generate a diagniostics (stderr) message
+
+=item L<Test::Stream::Event::Note>
+
+ $ctx->note("Note Message");
+
+Generate a note (stdout) message
+
+=item L<Test::Stream::Event::Bail>
+
+ $ctx->bail("Reason we are bailing");
+
+Stop the entire test file, something is very wrong!
+
+=item L<Test::Stream::Event::Plan>
+
+ $ctx->plan($max);
+ $ctx->plan(0, $directive, $reason);
+
+Set the plan.
+
+=back
+
+=head1 Testing your tools
+
+See L<Test::Stream::Tester>, which lets you intercept and validate events.
+
+B<DO NOT SEE> C<Test::Tester> and C<Test::Builder::Tester> which are both
+deprecated. They were once the way everyone tested their testers, but they do
+not allow you to test all events, and they are very fragile when upstream libs
+change.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/lib/Test/use/ok.pm b/cpan/Test-Simple/lib/Test/use/ok.pm
new file mode 100644
index 0000000000..ccbd5ad7ab
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/use/ok.pm
@@ -0,0 +1,150 @@
+package Test::use::ok;
+use strict;
+use warnings;
+use 5.005;
+
+our $VERSION = '1.301001_063';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+1;
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Test::use::ok - Alternative to Test::More::use_ok
+
+=head1 SYNOPSIS
+
+ use ok 'Some::Module';
+
+=head1 DESCRIPTION
+
+According to the B<Test::More> documentation, it used to be recommended to run
+C<use_ok()> inside a C<BEGIN> block, so functions are exported at compile-time
+and prototypes are properly honored.
+
+That is, instead of writing this:
+
+ use_ok( 'Some::Module' );
+ use_ok( 'Other::Module' );
+
+One should write this:
+
+ BEGIN { use_ok( 'Some::Module' ); }
+ BEGIN { use_ok( 'Other::Module' ); }
+
+However, people often either forget to add C<BEGIN>, or mistakenly group
+C<use_ok> with other tests in a single C<BEGIN> block, which can create subtle
+differences in execution order.
+
+With this module, simply change all C<use_ok> in test scripts to C<use ok>,
+and they will be executed at C<BEGIN> time. The explicit space after C<use>
+makes it clear that this is a single compile-time action.
+
+=head1 SEE ALSO
+
+L<Test::More>
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
+
+=cut
diff --git a/cpan/Test-Simple/lib/ok.pm b/cpan/Test-Simple/lib/ok.pm
new file mode 100644
index 0000000000..f20230e2fc
--- /dev/null
+++ b/cpan/Test-Simple/lib/ok.pm
@@ -0,0 +1,142 @@
+package ok;
+use strict;
+use warnings;
+
+use Test::More 1.301001 ();
+use Test::Stream::Carp qw/croak/;
+
+our $VERSION = '1.301001_063';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+sub import {
+ shift;
+
+ if (@_) {
+ croak "'use ok' called with an empty argument, did you try to use a package name from an uninitialized variable?"
+ unless defined $_[0];
+
+ goto &Test::More::pass if $_[0] eq 'ok';
+ goto &Test::More::use_ok;
+ }
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+ok - Alternative to Test::More::use_ok
+
+=head1 SYNOPSIS
+
+ use ok 'Some::Module';
+
+=head1 DESCRIPTION
+
+With this module, simply change all C<use_ok> in test scripts to C<use ok>,
+and they will be executed at C<BEGIN> time.
+
+Please see L<Test::use::ok> for the full description.
+
+=encoding utf8
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+The following people have all contributed to the Test-More dist (sorted using
+VIM's sort function).
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
+
+=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
+
+=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=item 唐鳳
+
+=back
+
+=head1 COPYRIGHT
+
+There has been a lot of code migration between modules,
+here are all the original copyrights together:
+
+=over 4
+
+=item Test::Stream
+
+=item Test::Stream::Tester
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::Simple
+
+=item Test::More
+
+=item Test::Builder
+
+Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
+inspiration from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
+gang.
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=item Test::use::ok
+
+To the extent possible under law, 唐鳳 has waived all copyright and related
+or neighboring rights to L<Test-use-ok>.
+
+This work is published from Taiwan.
+
+L<http://creativecommons.org/publicdomain/zero/1.0>
+
+=item Test::Tester
+
+This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
+are based on other people's work.
+
+Under the same license as Perl itself
+
+See http://www.perl.com/perl/misc/Artistic.html
+
+=item Test::Builder::Tester
+
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=back
diff --git a/cpan/Test-Simple/t/00test_harness_check.t b/cpan/Test-Simple/t/00test_harness_check.t
deleted file mode 100644
index 3ff4a13c63..0000000000
--- a/cpan/Test-Simple/t/00test_harness_check.t
+++ /dev/null
@@ -1,26 +0,0 @@
-#!/usr/bin/perl -w
-
-# A test to make sure the new Test::Harness was installed properly.
-
-use Test::More;
-plan tests => 1;
-
-my $TH_Version = 2.03;
-
-require Test::Harness;
-unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) {
- diag <<INSTRUCTIONS;
-
-Test::Simple/More/Builder has features which depend on a version of
-Test::Harness greater than $TH_Version. You have $Test::Harness::VERSION.
-Please install a new version from CPAN.
-
-If you've already tried to upgrade Test::Harness and still get this
-message, the new version may be "shadowed" by the old. Check the
-output of Test::Harness's "make install" for "## Differing version"
-messages. You can delete the old version by running
-"make install UNINST=1".
-
-INSTRUCTIONS
-}
-
diff --git a/cpan/Test-Simple/t/Behavior/MonkeyPatching_diag.t b/cpan/Test-Simple/t/Behavior/MonkeyPatching_diag.t
new file mode 100644
index 0000000000..978e3f3313
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/MonkeyPatching_diag.t
@@ -0,0 +1,97 @@
+use strict;
+use warnings;
+use B;
+
+use Test::Stream;
+use Test::MostlyLike;
+use Test::More tests => 3;
+use Test::Builder; # Not loaded by default in modern mode
+my $orig = Test::Builder->can('diag');
+
+{
+ package MyModernTester;
+ use Test::More;
+ use Test::Stream;
+ use Test::MostlyLike;
+
+ no warnings 'redefine';
+ local *Test::Builder::diag = sub {
+ my $self = shift;
+ return $self->$orig(__PACKAGE__ . ": ", @_);
+ };
+ use warnings;
+
+ my $file = __FILE__;
+ # Line number is tricky, just use what B says The sub may not actually think it
+ # is on the line it is may be off by 1.
+ my $line = B::svref_2object(\&Test::Builder::diag)->START->line;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ diag('first');
+ diag('seconds');
+ }
+ mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'MyModernTester::__ANON__' defined in $file around line $line},
+ undef, #Only 1 warning
+ ],
+ "Found expected warning, just the one"
+ );
+}
+
+{
+ package MyModernTester2;
+ use Test::More;
+ use Test::Stream;
+ use Test::MostlyLike;
+
+ no warnings 'redefine';
+ local *Test::Builder::diag = sub {
+ my $self = shift;
+ return $self->$orig(__PACKAGE__ . ": ", @_);
+ };
+ use warnings;
+
+ my $file = __FILE__;
+ # Line number is tricky, just use what B says The sub may not actually think it
+ # is on the line it is may be off by 1.
+ my $line = B::svref_2object(\&Test::Builder::diag)->START->line;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ diag('first');
+ diag('seconds');
+ }
+ mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'MyModernTester2::__ANON__' defined in $file around line $line},
+ undef, #Only 1 warning
+ ],
+ "new override, new warning"
+ );
+}
+
+{
+ package MyLegacyTester;
+ use Test::More;
+
+ no warnings 'redefine';
+ local *Test::Builder::diag = sub {
+ my $self = shift;
+ return $self->$orig(__PACKAGE__ . ": ", @_);
+ };
+ use warnings;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ diag('first');
+ diag('seconds');
+ }
+ is(@warnings, 0, "no warnings for a legacy tester");
+}
diff --git a/cpan/Test-Simple/t/Behavior/MonkeyPatching_done_testing.t b/cpan/Test-Simple/t/Behavior/MonkeyPatching_done_testing.t
new file mode 100644
index 0000000000..4a1d2851a5
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/MonkeyPatching_done_testing.t
@@ -0,0 +1,61 @@
+use strict;
+use warnings;
+use B;
+
+use Test::Stream;
+use Test::MostlyLike;
+use Test::More tests => 4;
+use Test::Builder; # Not loaded by default in modern mode
+my $orig = Test::Builder->can('done_testing');
+
+use Test::Stream::Tester;
+
+my $ran = 0;
+no warnings 'redefine';
+my $file = __FILE__;
+my $line = __LINE__ + 1;
+*Test::Builder::done_testing = sub { my $self = shift; $ran++; $self->$orig(@_) };
+use warnings;
+
+my @warnings;
+$SIG{__WARN__} = sub { push @warnings => @_ };
+
+events_are(
+ intercept {
+ ok(1, "pass");
+ ok(0, "fail");
+
+ done_testing;
+ },
+ check {
+ event ok => { bool => 1 };
+ event ok => { bool => 0 };
+ event plan => { max => 2 };
+ directive 'end';
+ },
+);
+
+events_are(
+ intercept {
+ ok(1, "pass");
+ ok(0, "fail");
+
+ done_testing;
+ },
+ check {
+ event ok => { bool => 1 };
+ event ok => { bool => 0 };
+ event plan => { max => 2 };
+ directive 'end';
+ },
+);
+
+is($ran, 2, "We ran our override both times");
+mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'main::__ANON__' defined in $file around line $line},
+ undef,
+ ],
+ "Got the warning once"
+);
diff --git a/cpan/Test-Simple/t/Behavior/MonkeyPatching_note.t b/cpan/Test-Simple/t/Behavior/MonkeyPatching_note.t
new file mode 100644
index 0000000000..5594acd9db
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/MonkeyPatching_note.t
@@ -0,0 +1,97 @@
+use strict;
+use warnings;
+use B;
+
+use Test::Stream;
+use Test::MostlyLike;
+use Test::More tests => 3;
+use Test::Builder; # Not loaded by default in modern mode
+my $orig = Test::Builder->can('note');
+
+{
+ package MyModernTester;
+ use Test::More;
+ use Test::Stream;
+ use Test::MostlyLike;
+
+ no warnings 'redefine';
+ local *Test::Builder::note = sub {
+ my $self = shift;
+ return $self->$orig(__PACKAGE__ . ": ", @_);
+ };
+ use warnings;
+
+ my $file = __FILE__;
+ # Line number is tricky, just use what B says The sub may not actually think it
+ # is on the line it is may be off by 1.
+ my $line = B::svref_2object(\&Test::Builder::note)->START->line;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ note('first');
+ note('seconds');
+ }
+ mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'MyModernTester::__ANON__' defined in $file around line $line},
+ undef, #Only 1 warning
+ ],
+ "Found expected warning, just the one"
+ );
+}
+
+{
+ package MyModernTester2;
+ use Test::More;
+ use Test::Stream;
+ use Test::MostlyLike;
+
+ no warnings 'redefine';
+ local *Test::Builder::note = sub {
+ my $self = shift;
+ return $self->$orig(__PACKAGE__ . ": ", @_);
+ };
+ use warnings;
+
+ my $file = __FILE__;
+ # Line number is tricky, just use what B says The sub may not actually think it
+ # is on the line it is may be off by 1.
+ my $line = B::svref_2object(\&Test::Builder::note)->START->line;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ note('first');
+ note('seconds');
+ }
+ mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'MyModernTester2::__ANON__' defined in $file around line $line},
+ undef, #Only 1 warning
+ ],
+ "new override, new warning"
+ );
+}
+
+{
+ package MyLegacyTester;
+ use Test::More;
+
+ no warnings 'redefine';
+ local *Test::Builder::note = sub {
+ my $self = shift;
+ return $self->$orig(__PACKAGE__ . ": ", @_);
+ };
+ use warnings;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ note('first');
+ note('seconds');
+ }
+ is(@warnings, 0, "no warnings for a legacy tester");
+}
diff --git a/cpan/Test-Simple/t/Behavior/MonkeyPatching_ok.t b/cpan/Test-Simple/t/Behavior/MonkeyPatching_ok.t
new file mode 100644
index 0000000000..f10b18b199
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/MonkeyPatching_ok.t
@@ -0,0 +1,108 @@
+use strict;
+use warnings;
+use B;
+
+use Test::Stream;
+use Test::MostlyLike;
+use Test::More tests => 9;
+use Test::Builder; # Not loaded by default in modern mode
+my $orig = Test::Builder->can('ok');
+
+{
+ package MyModernTester;
+ use Test::Stream;
+ use Test::MostlyLike;
+ use Test::More;
+
+ no warnings 'redefine';
+ local *Test::Builder::ok = sub {
+ my $self = shift;
+ my ($bool, $name) = @_;
+ $name = __PACKAGE__ . ": $name";
+ return $self->$orig($bool, $name);
+ };
+ use warnings;
+
+ my $file = __FILE__;
+ # Line number is tricky, just use what B says The sub may not actually think it
+ # is on the line it is may be off by 1.
+ my $line = B::svref_2object(\&Test::Builder::ok)->START->line;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ ok(1, "fred");
+ ok(2, "barney");
+ }
+ mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'MyModernTester::__ANON__' defined in $file around line $line},
+ undef, #Only 1 warning
+ ],
+ "Found expected warning, just the one"
+ );
+}
+
+{
+ package MyModernTester2;
+ use Test::Stream;
+ use Test::MostlyLike;
+ use Test::More;
+
+ no warnings 'redefine';
+ local *Test::Builder::ok = sub {
+ my $self = shift;
+ my ($bool, $name) = @_;
+ $name = __PACKAGE__ . ": $name";
+ return $self->$orig($bool, $name);
+ };
+ use warnings;
+
+ my $file = __FILE__;
+ # Line number is tricky, just use what B says The sub may not actually think it
+ # is on the line it is may be off by 1.
+ my $line = B::svref_2object(\&Test::Builder::ok)->START->line;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ ok(1, "fred");
+ ok(2, "barney");
+ }
+ mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'MyModernTester2::__ANON__' defined in $file around line $line},
+ undef, #Only 1 warning
+ ],
+ "new override, new warning"
+ );
+}
+
+{
+ package MyLegacyTester;
+ use Test::More;
+
+ no warnings 'redefine';
+ local *Test::Builder::ok = sub {
+ my $self = shift;
+ my ($bool, $name) = @_;
+ $name = __PACKAGE__ . ": $name";
+ return $self->$orig($bool, $name);
+ };
+ use warnings;
+
+ my $file = __FILE__;
+ # Line number is tricky, just use what B says The sub may not actually think it
+ # is on the line it is may be off by 1.
+ my $line = B::svref_2object(\&Test::Builder::ok)->START->line;
+
+ my @warnings;
+ {
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ ok(1, "fred");
+ ok(2, "barney");
+ }
+ is(@warnings, 0, "no warnings for a legacy tester");
+}
diff --git a/cpan/Test-Simple/t/Behavior/MonkeyPatching_plan.t b/cpan/Test-Simple/t/Behavior/MonkeyPatching_plan.t
new file mode 100644
index 0000000000..b44d08c9a7
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/MonkeyPatching_plan.t
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+use B;
+
+use Test::Stream;
+use Test::MostlyLike;
+use Test::More tests => 6;
+use Test::Builder; # Not loaded by default in modern mode
+my $orig = Test::Builder->can('plan');
+
+use Test::Stream::Tester;
+
+my $ran = 0;
+no warnings 'redefine';
+my $file = __FILE__;
+my $line = __LINE__ + 1;
+*Test::Builder::plan = sub { my $self = shift; $ran++; $self->$orig(@_) };
+use warnings;
+
+my @warnings;
+$SIG{__WARN__} = sub { push @warnings => @_ };
+
+events_are(
+ intercept {
+ plan tests => 2;
+ ok(1, "pass");
+ ok(0, "fail");
+ },
+ check {
+ event plan => { max => 2 };
+ event ok => { bool => 1 };
+ event ok => { bool => 0 };
+ directive 'end';
+ },
+);
+
+events_are(
+ intercept {
+ Test::More->import('tests' => 2);
+ ok(1, "pass");
+ ok(0, "fail");
+ },
+ check {
+ event plan => { max => 2 };
+ event ok => { bool => 1 };
+ event ok => { bool => 0 };
+ directive 'end';
+ },
+);
+
+events_are(
+ intercept {
+ Test::More->import(skip_all => 'damn');
+ ok(1, "pass");
+ ok(0, "fail");
+ },
+ check {
+ event plan => { max => 0, directive => 'SKIP', reason => 'damn' };
+ directive 'end';
+ },
+);
+
+events_are(
+ intercept {
+ Test::More->import('no_plan');
+ ok(1, "pass");
+ ok(0, "fail");
+ },
+ check {
+ event plan => { directive => 'NO PLAN' };
+ event ok => { bool => 1 };
+ event ok => { bool => 0 };
+ directive 'end';
+ },
+);
+
+is($ran, 4, "We ran our override each time");
+mostly_like(
+ \@warnings,
+ [
+ qr{The new sub is 'main::__ANON__' defined in $file around line $line},
+ undef,
+ ],
+ "Got the warning once"
+);
+
diff --git a/cpan/Test-Simple/t/Behavior/Munge.t b/cpan/Test-Simple/t/Behavior/Munge.t
new file mode 100644
index 0000000000..be9aa98d5c
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/Munge.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::Stream;
+use Test::More;
+use Test::Stream::Tester;
+
+events_are(
+ intercept {
+ my $id = 0;
+ Test::Stream->shared->munge(sub {
+ my ($stream, $e) = @_;
+ return unless $e->isa('Test::Stream::Event::Ok');
+ return if defined $e->name;
+ $e->set_name( 'flubber: ' . $id++ );
+ });
+
+ ok( 1, "Keep the name" );
+ ok( 1 );
+ ok( 1, "Already named" );
+ ok( 1 );
+ },
+ check {
+ event ok => { bool => 1, name => "Keep the name" };
+ event ok => { bool => 1, name => "flubber: 0" };
+ event ok => { bool => 1, name => "Already named" };
+ event ok => { bool => 1, name => "flubber: 1" };
+ }
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Behavior/NotTB15.t b/cpan/Test-Simple/t/Behavior/NotTB15.t
new file mode 100644
index 0000000000..a70992599d
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/NotTB15.t
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Builder;
+
+# This is just a list of method Test::Builder current does not have that Test::Builder 1.5 does.
+my @TB15_METHODS = qw{
+ _file_and_line _join_message _make_default _my_exit _reset_todo_state
+ _result_to_hash _results _todo_state formatter history in_test
+ no_change_exit_code post_event post_result set_formatter set_plan test_end
+ test_exit_code test_start test_state
+};
+
+for my $method (qw/foo bar baz/) {
+ my $success = !eval { Test::Builder->$method; 1 }; my $line = __LINE__;
+ my $error = $@;
+ ok($success, "Threw an exception ($method)");
+ is(
+ $error,
+ qq{Can't locate object method "$method" via package "Test::Builder" at } . __FILE__ . " line $line.\n",
+ "Did not auto-create random sub ($method)"
+ );
+}
+
+my $file = __FILE__;
+for my $method (@TB15_METHODS) {
+ my $success = !eval { Test::Builder->$method; 1 }; my $line = __LINE__;
+ my $error = $@;
+
+ ok($success, "Threw an exception ($method)");
+
+ is($error, <<" EOT", "Got expected error ($method)");
+Can't locate object method "$method" via package "Test::Builder" at $file line $line.
+
+ *************************************************************************
+ '$method' is a Test::Builder 1.5 method. Test::Builder 1.5 is a dead branch.
+ You need to update your code so that it no longer treats Test::Builders
+ over a specific version number as anything special.
+
+ See: http://blogs.perl.org/users/chad_exodist_granum/2014/03/testmore---new-maintainer-also-stop-version-checking.html
+ *************************************************************************
+ EOT
+}
+
+done_testing;
+
diff --git a/cpan/Test-Simple/t/Behavior/Tester2_subtest.t b/cpan/Test-Simple/t/Behavior/Tester2_subtest.t
new file mode 100644
index 0000000000..6101fbb92a
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/Tester2_subtest.t
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+use utf8;
+
+use Test::Stream;
+use Test::More;
+use Test::Stream::Tester;
+
+my $events = intercept {
+ ok(0, "test failure" );
+ ok(1, "test success" );
+
+ subtest 'subtest' => sub {
+ ok(0, "subtest failure" );
+ ok(1, "subtest success" );
+
+ subtest 'subtest_deeper' => sub {
+ ok(1, "deeper subtest success" );
+ };
+ };
+
+ ok(0, "another test failure" );
+ ok(1, "another test success" );
+};
+
+events_are(
+ $events,
+
+ check {
+ event ok => {bool => 0, diag => qr/Fail/};
+ event ok => {bool => 1};
+
+ event note => {message => 'Subtest: subtest'};
+ event subtest => {
+ name => 'subtest',
+ bool => 0,
+ diag => qr/Failed test 'subtest'/,
+
+ events => check {
+ event ok => {bool => 0};
+ event ok => {bool => 1};
+
+ event note => {message => 'Subtest: subtest_deeper'};
+ event subtest => {
+ bool => 1,
+ name => 'subtest_deeper',
+ events => check {
+ event ok => { bool => 1 };
+ },
+ };
+
+ event plan => { max => 3 };
+ event finish => { tests_run => 3, tests_failed => 1 };
+ event diag => { message => qr/Looks like you failed 1 test of 3/ };
+
+ dir end => 'End of subtests events';
+ },
+ };
+
+ event ok => {bool => 0};
+ event ok => {bool => 1};
+
+ dir end => "subtest events as expected";
+ },
+
+ "Subtest events"
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Behavior/cmp_ok_xor.t b/cpan/Test-Simple/t/Behavior/cmp_ok_xor.t
new file mode 100644
index 0000000000..292f7168be
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/cmp_ok_xor.t
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+my @warnings;
+$SIG{__WARN__} = sub { push @warnings => @_ };
+my $ok = cmp_ok( 1, 'xor', 0, 'use xor in cmp_ok' );
+ok(!@warnings, "no warnings");
+ok($ok, "returned true");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Behavior/encoding_test.t b/cpan/Test-Simple/t/Behavior/encoding_test.t
new file mode 100644
index 0000000000..57242e03d9
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/encoding_test.t
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+no utf8;
+
+# line 5 "encoding_tést.t"
+
+use Test::Stream;
+use Test::More;
+use Test::Stream::Tester;
+
+BEGIN {
+ my $norm = eval { require Unicode::Normalize; require Encode; 1 };
+ plan skip_all => 'Unicode::Normalize is required for this test' unless $norm;
+}
+
+my $filename = __FILE__;
+ok(!utf8::is_utf8($filename), "filename is not in utf8 yet");
+my $utf8name = Unicode::Normalize::NFKC(Encode::decode('utf8', "$filename", Encode::FB_CROAK));
+ok( $filename ne $utf8name, "sanity check" );
+
+my $scoper = sub { context()->snapshot };
+
+tap_encoding 'utf8';
+my $ctx_utf8 = $scoper->();
+
+tap_encoding 'legacy';
+my $ctx_legacy = $scoper->();
+
+is($ctx_utf8->encoding, 'utf8', "got a utf8 context");
+is($ctx_legacy->encoding, 'legacy', "got a legacy context");
+
+is($ctx_utf8->file, $utf8name, "Got utf8 name");
+is($ctx_legacy->file, $filename, "Got legacy name");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Behavior/fork_new_end.t b/cpan/Test-Simple/t/Behavior/fork_new_end.t
new file mode 100644
index 0000000000..d15b9d9164
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/fork_new_end.t
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use Config;
+
+BEGIN {
+ if ($] == 5.010000) {
+ print "1..0 # Threads are broken on 5.10.0\n";
+ exit 0;
+ }
+
+ my $works = 1;
+ $works &&= $] >= 5.008001;
+ $works &&= $Config{'useithreads'};
+ $works &&= eval { require threads; 'threads'->import; 1 };
+
+ unless ($works) {
+ print "1..0 # Skip no working threads\n";
+ exit 0;
+ }
+
+ unless ( $ENV{AUTHOR_TESTING} ) {
+ print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
+ exit 0;
+ }
+}
+
+use Test::More tests => 4;
+
+ok(1, "outside before");
+
+my $run = sub {
+ ok(1, 'in thread1');
+ ok(1, 'in thread2');
+};
+
+
+my $t = threads->create($run);
+
+ok(1, "outside after");
+
+$t->join;
+
+END {
+ print "XXX: " . Test::Builder->new->is_passing . "\n";
+}
diff --git a/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t b/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
new file mode 100644
index 0000000000..5f73ffaac2
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl -w -T
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use Config;
+
+BEGIN {
+ if ($] == 5.010000) {
+ print "1..0 # Threads are broken on 5.10.0\n";
+ exit 0;
+ }
+
+ my $works = 1;
+ $works &&= $] >= 5.008001;
+ $works &&= $Config{'useithreads'};
+ $works &&= eval { require threads; 'threads'->import; 1 };
+
+ unless ($works) {
+ print "1..0 # Skip no working threads\n";
+ exit 0;
+ }
+
+ unless ( $ENV{AUTHOR_TESTING} ) {
+ print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
+ exit 0;
+ }
+}
+
+use strict;
+use Test::Builder;
+
+my $Test = Test::Builder->new;
+$Test->exported_to('main');
+$Test->plan(tests => 6);
+
+for(1..5) {
+ 'threads'->create(sub {
+ $Test->ok(1,"Each of these should app the test number")
+ })->join;
+}
+
+$Test->is_num($Test->current_test(), 5,"Should be five");
diff --git a/cpan/Test-Simple/t/Behavior/todo.t b/cpan/Test-Simple/t/Behavior/todo.t
new file mode 100644
index 0000000000..cb5a6e34b0
--- /dev/null
+++ b/cpan/Test-Simple/t/Behavior/todo.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Stream::Tester;
+
+my $events = intercept {
+ local $TODO = "";
+ ok(0, "Should not be in todo 1");
+
+ local $TODO = 0;
+ ok(0, "Should not be in todo 2");
+
+ local $TODO = undef;
+ ok(0, "Should not be in todo 3");
+
+ local $TODO = "foo";
+ ok(0, "Should be in todo");
+};
+
+events_are(
+ $events,
+ check {
+ event ok => { in_todo => 0 };
+ event ok => { in_todo => 0 };
+ event ok => { in_todo => 0 };
+ event ok => { in_todo => 1 };
+ directive 'end';
+ },
+ "Verify TODO state"
+);
+
+my $i = 0;
+for my $e (@$events) {
+ next if $e->context->in_todo;
+
+ my @tap = $e->to_tap(++$i);
+ my $ok_line = $tap[0];
+ chomp(my $text = $ok_line->[1]);
+ is($text, "not ok $i - Should not be in todo $i", "No TODO directive $i");
+}
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Builder/fork_with_new_stdout.t b/cpan/Test-Simple/t/Builder/fork_with_new_stdout.t
deleted file mode 100644
index e38c1d08cb..0000000000
--- a/cpan/Test-Simple/t/Builder/fork_with_new_stdout.t
+++ /dev/null
@@ -1,54 +0,0 @@
-#!perl -w
-use strict;
-use warnings;
-use IO::Pipe;
-use Test::Builder;
-use Config;
-
-my $b = Test::Builder->new;
-$b->reset;
-
-my $Can_Fork = $Config{d_fork} ||
- (($^O eq 'MSWin32' || $^O eq 'NetWare') and
- $Config{useithreads} and
- $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
- );
-
-if( !$Can_Fork ) {
- $b->plan('skip_all' => "This system cannot fork");
-}
-else {
- $b->plan('tests' => 2);
-}
-
-my $pipe = IO::Pipe->new;
-if ( my $pid = fork ) {
- $pipe->reader;
- $b->ok((<$pipe> =~ /FROM CHILD: ok 1/), "ok 1 from child");
- $b->ok((<$pipe> =~ /FROM CHILD: 1\.\.1/), "1..1 from child");
- waitpid($pid, 0);
-}
-else {
- $pipe->writer;
- my $pipe_fd = $pipe->fileno;
- close STDOUT;
- open(STDOUT, ">&$pipe_fd");
- my $b = Test::Builder->new;
- $b->reset;
- $b->no_plan;
- $b->ok(1);
-}
-
-
-=pod
-#actual
-1..2
-ok 1
-1..1
-ok 1
-ok 2
-#expected
-1..2
-ok 1
-ok 2
-=cut
diff --git a/cpan/Test-Simple/t/Builder/try.t b/cpan/Test-Simple/t/Builder/try.t
deleted file mode 100644
index eeb3bcb1ab..0000000000
--- a/cpan/Test-Simple/t/Builder/try.t
+++ /dev/null
@@ -1,42 +0,0 @@
-#!perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More 'no_plan';
-
-require Test::Builder;
-my $tb = Test::Builder->new;
-
-
-# Test that _try() has no effect on $@ and $! and is not effected by
-# __DIE__
-{
- local $SIG{__DIE__} = sub { fail("DIE handler called: @_") };
- local $@ = 42;
- local $! = 23;
-
- is $tb->_try(sub { 2 }), 2;
- is $tb->_try(sub { return '' }), '';
-
- is $tb->_try(sub { die; }), undef;
-
- is_deeply [$tb->_try(sub { die "Foo\n" })], [undef, "Foo\n"];
-
- is $@, 42;
- cmp_ok $!, '==', 23;
-}
-
-ok !eval {
- $tb->_try(sub { die "Died\n" }, die_on_fail => 1);
-};
-is $@, "Died\n";
diff --git a/cpan/Test-Simple/t/BEGIN_require_ok.t b/cpan/Test-Simple/t/Legacy/BEGIN_require_ok.t
index 733d0bb861..733d0bb861 100644
--- a/cpan/Test-Simple/t/BEGIN_require_ok.t
+++ b/cpan/Test-Simple/t/Legacy/BEGIN_require_ok.t
diff --git a/cpan/Test-Simple/t/BEGIN_use_ok.t b/cpan/Test-Simple/t/Legacy/BEGIN_use_ok.t
index 476badf7a2..476badf7a2 100644
--- a/cpan/Test-Simple/t/BEGIN_use_ok.t
+++ b/cpan/Test-Simple/t/Legacy/BEGIN_use_ok.t
diff --git a/cpan/Test-Simple/t/Builder/Builder.t b/cpan/Test-Simple/t/Legacy/Builder/Builder.t
index a5bfd155a6..a5bfd155a6 100644
--- a/cpan/Test-Simple/t/Builder/Builder.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/Builder.t
diff --git a/cpan/Test-Simple/t/Builder/carp.t b/cpan/Test-Simple/t/Legacy/Builder/carp.t
index e89eeebfb9..b6b5518d66 100644
--- a/cpan/Test-Simple/t/Builder/carp.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/carp.t
@@ -1,4 +1,6 @@
#!/usr/bin/perl
+use strict;
+use warnings;
BEGIN {
if( $ENV{PERL_CORE} ) {
@@ -11,14 +13,13 @@ BEGIN {
use Test::More tests => 3;
use Test::Builder;
-my $tb = Test::Builder->create;
-sub foo { $tb->croak("foo") }
-sub bar { $tb->carp("bar") }
+sub foo { my $ctx = context(); Test::Builder->new->croak("foo") }
+sub bar { my $ctx = context(); Test::Builder->new->carp("bar") }
eval { foo() };
is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1;
-eval { $tb->croak("this") };
+eval { Test::Builder->new->croak("this") };
is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1;
{
diff --git a/cpan/Test-Simple/t/Builder/create.t b/cpan/Test-Simple/t/Legacy/Builder/create.t
index 64be8511d8..64be8511d8 100644
--- a/cpan/Test-Simple/t/Builder/create.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/create.t
diff --git a/cpan/Test-Simple/t/Builder/current_test.t b/cpan/Test-Simple/t/Legacy/Builder/current_test.t
index edd201c0e9..edd201c0e9 100644
--- a/cpan/Test-Simple/t/Builder/current_test.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/current_test.t
diff --git a/cpan/Test-Simple/t/Builder/current_test_without_plan.t b/cpan/Test-Simple/t/Legacy/Builder/current_test_without_plan.t
index 31f9589977..31f9589977 100644
--- a/cpan/Test-Simple/t/Builder/current_test_without_plan.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/current_test_without_plan.t
diff --git a/cpan/Test-Simple/t/Builder/details.t b/cpan/Test-Simple/t/Legacy/Builder/details.t
index 05d4828b4d..05d4828b4d 100644
--- a/cpan/Test-Simple/t/Builder/details.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/details.t
diff --git a/cpan/Test-Simple/t/Builder/done_testing.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing.t
index 14a8f918b0..14a8f918b0 100644
--- a/cpan/Test-Simple/t/Builder/done_testing.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing.t
diff --git a/cpan/Test-Simple/t/Builder/done_testing_double.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_double.t
index 3a0bae247b..3a0bae247b 100644
--- a/cpan/Test-Simple/t/Builder/done_testing_double.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_double.t
diff --git a/cpan/Test-Simple/t/Builder/done_testing_plan_mismatch.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_plan_mismatch.t
index 8208635359..8208635359 100644
--- a/cpan/Test-Simple/t/Builder/done_testing_plan_mismatch.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_plan_mismatch.t
diff --git a/cpan/Test-Simple/t/Builder/done_testing_with_no_plan.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_no_plan.t
index ff5f40c197..ff5f40c197 100644
--- a/cpan/Test-Simple/t/Builder/done_testing_with_no_plan.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_no_plan.t
diff --git a/cpan/Test-Simple/t/Builder/done_testing_with_number.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_number.t
index c21458f54e..c21458f54e 100644
--- a/cpan/Test-Simple/t/Builder/done_testing_with_number.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_number.t
diff --git a/cpan/Test-Simple/t/Builder/done_testing_with_plan.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_plan.t
index c0a3d0f014..2d10322eea 100644
--- a/cpan/Test-Simple/t/Builder/done_testing_with_plan.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_plan.t
@@ -5,7 +5,7 @@ use strict;
use Test::Builder;
my $tb = Test::Builder->new;
-$tb->plan( tests => 2 );
+$tb->plan(tests => 2);
$tb->ok(1);
$tb->ok(1);
$tb->done_testing(2);
diff --git a/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
new file mode 100644
index 0000000000..bcd7156e89
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
@@ -0,0 +1,57 @@
+#!perl -w
+use strict;
+use warnings;
+use IO::Pipe;
+use Test::Builder;
+use Config;
+
+my $b = Test::Builder->new;
+$b->reset;
+
+my $Can_Fork = $Config{d_fork}
+ || (($^O eq 'MSWin32' || $^O eq 'NetWare')
+ and $Config{useithreads}
+ and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
+
+if (!$Can_Fork) {
+ $b->plan('skip_all' => "This system cannot fork");
+}
+else {
+ $b->plan('tests' => 2);
+}
+
+my $pipe = IO::Pipe->new;
+if (my $pid = fork) {
+ $pipe->reader;
+ my @output = <$pipe>;
+ $b->like($output[0], qr/ok 1/, "ok 1 from child");
+ $b->like($output[1], qr/1\.\.1/, "got 1..1 from child");
+ waitpid($pid, 0);
+}
+else {
+ Test::Stream::IOSets->hard_reset;
+ Test::Stream->clear;
+ $pipe->writer;
+ my $pipe_fd = $pipe->fileno;
+ close STDOUT;
+ open(STDOUT, ">&$pipe_fd");
+ my $b = Test::Builder->create(shared_stream => 1);
+ $b->reset;
+ $b->no_plan;
+ $b->ok(1);
+
+ exit 0;
+}
+
+=pod
+#actual
+1..2
+ok 1
+1..1
+ok 1
+ok 2
+#expected
+1..2
+ok 1
+ok 2
+=cut
diff --git a/cpan/Test-Simple/t/Builder/has_plan.t b/cpan/Test-Simple/t/Legacy/Builder/has_plan.t
index d0be86a97a..d0be86a97a 100644
--- a/cpan/Test-Simple/t/Builder/has_plan.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/has_plan.t
diff --git a/cpan/Test-Simple/t/Builder/has_plan2.t b/cpan/Test-Simple/t/Legacy/Builder/has_plan2.t
index e13ea4af94..e13ea4af94 100644
--- a/cpan/Test-Simple/t/Builder/has_plan2.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/has_plan2.t
diff --git a/cpan/Test-Simple/t/Builder/is_fh.t b/cpan/Test-Simple/t/Legacy/Builder/is_fh.t
index 0eb3ec0b15..f7a5f1a80d 100644
--- a/cpan/Test-Simple/t/Builder/is_fh.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/is_fh.t
@@ -41,7 +41,7 @@ package Lying::isa;
sub isa {
my $self = shift;
my $parent = shift;
-
+
return 1 if $parent eq 'IO::Handle';
}
diff --git a/cpan/Test-Simple/t/Builder/is_passing.t b/cpan/Test-Simple/t/Legacy/Builder/is_passing.t
index d335aada57..d335aada57 100644
--- a/cpan/Test-Simple/t/Builder/is_passing.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/is_passing.t
diff --git a/cpan/Test-Simple/t/Builder/maybe_regex.t b/cpan/Test-Simple/t/Legacy/Builder/maybe_regex.t
index d1927a56e5..fd8b8d06ed 100644
--- a/cpan/Test-Simple/t/Builder/maybe_regex.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/maybe_regex.t
@@ -23,7 +23,7 @@ ok(('bar' !~ /$r/), 'qr// bad match');
SKIP: {
skip "blessed regex checker added in 5.10", 3 if $] < 5.010;
-
+
my $obj = bless qr/foo/, 'Wibble';
my $re = $Test->maybe_regex($obj);
ok( defined $re, "blessed regex detected" );
diff --git a/cpan/Test-Simple/t/Builder/no_diag.t b/cpan/Test-Simple/t/Legacy/Builder/no_diag.t
index 6fa538a82e..6fa538a82e 100644
--- a/cpan/Test-Simple/t/Builder/no_diag.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/no_diag.t
diff --git a/cpan/Test-Simple/t/Builder/no_ending.t b/cpan/Test-Simple/t/Legacy/Builder/no_ending.t
index 03e0cc489d..03e0cc489d 100644
--- a/cpan/Test-Simple/t/Builder/no_ending.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/no_ending.t
diff --git a/cpan/Test-Simple/t/Builder/no_header.t b/cpan/Test-Simple/t/Legacy/Builder/no_header.t
index 93e6bec34c..93e6bec34c 100644
--- a/cpan/Test-Simple/t/Builder/no_header.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/no_header.t
diff --git a/cpan/Test-Simple/t/Builder/no_plan_at_all.t b/cpan/Test-Simple/t/Legacy/Builder/no_plan_at_all.t
index 64a0e19476..64a0e19476 100644
--- a/cpan/Test-Simple/t/Builder/no_plan_at_all.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/no_plan_at_all.t
diff --git a/cpan/Test-Simple/t/Builder/ok_obj.t b/cpan/Test-Simple/t/Legacy/Builder/ok_obj.t
index 8678dbff8d..8678dbff8d 100644
--- a/cpan/Test-Simple/t/Builder/ok_obj.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/ok_obj.t
diff --git a/cpan/Test-Simple/t/Builder/output.t b/cpan/Test-Simple/t/Legacy/Builder/output.t
index 77e0e0bbb3..77e0e0bbb3 100644
--- a/cpan/Test-Simple/t/Builder/output.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/output.t
diff --git a/cpan/Test-Simple/t/Builder/reset.t b/cpan/Test-Simple/t/Legacy/Builder/reset.t
index 3bc44457fc..fd11db71b2 100644
--- a/cpan/Test-Simple/t/Builder/reset.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/reset.t
@@ -13,7 +13,6 @@ BEGIN {
}
chdir 't';
-
use Test::Builder;
my $Test = Test::Builder->new;
my $tb = Test::Builder->create;
@@ -56,7 +55,6 @@ $Test->is_eq( $tb->expected_tests, 0, 'expected_tests' );
$Test->is_eq( $tb->level, 1, 'level' );
$Test->is_eq( $tb->use_numbers, 1, 'use_numbers' );
$Test->is_eq( $tb->no_header, 0, 'no_header' );
-$Test->is_eq( $tb->no_ending, 0, 'no_ending' );
$Test->is_eq( $tb->current_test, 0, 'current_test' );
$Test->is_eq( scalar $tb->summary, 0, 'summary' );
$Test->is_eq( scalar $tb->details, 0, 'details' );
@@ -70,7 +68,6 @@ $Test->is_eq( fileno $tb->todo_output,
# The reset Test::Builder will take over from here.
$Test->no_ending(1);
-
$tb->current_test($Test->current_test);
$tb->level(0);
$tb->ok(1, 'final test to make sure output was reset');
diff --git a/cpan/Test-Simple/t/Legacy/Builder/reset_outputs.t b/cpan/Test-Simple/t/Legacy/Builder/reset_outputs.t
new file mode 100644
index 0000000000..b199128ad3
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/Builder/reset_outputs.t
@@ -0,0 +1,35 @@
+#!perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use Test::Builder;
+use Test::More 'no_plan';
+
+{
+ my $tb = Test::Builder->create();
+
+ # Store the original output filehandles and change them all.
+ my %original_outputs;
+
+ open my $fh, ">", "dummy_file.tmp";
+ END { 1 while unlink "dummy_file.tmp"; }
+ for my $method (qw(output failure_output todo_output)) {
+ $original_outputs{$method} = $tb->$method();
+ $tb->$method($fh);
+ is $tb->$method(), $fh;
+ }
+
+ $tb->reset_outputs;
+
+ for my $method (qw(output failure_output todo_output)) {
+ is $tb->$method(), $original_outputs{$method}, "reset_outputs() resets $method";
+ }
+}
diff --git a/cpan/Test-Simple/t/More.t b/cpan/Test-Simple/t/Legacy/More.t
index ce535e26d9..b4f680bb31 100644
--- a/cpan/Test-Simple/t/More.t
+++ b/cpan/Test-Simple/t/Legacy/More.t
@@ -9,6 +9,7 @@ BEGIN {
use lib 't/lib';
use Test::More tests => 54;
+use Test::Builder;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
@@ -40,7 +41,7 @@ unlike(@foo, '/foo/');
can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
pass fail eq_array eq_hash eq_set));
-can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
+can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
can_ok pass fail eq_array eq_hash eq_set));
@@ -54,7 +55,7 @@ isa_ok(\42, 'SCALAR');
}
-# can_ok() & isa_ok should call can() & isa() on the given object, not
+# can_ok() & isa_ok should call can() & isa() on the given object, not
# just class, in case of custom can()
{
local *Foo::can;
@@ -143,7 +144,7 @@ ok( !eq_hash(\%hash1, \%hash2),
'eq_hash with slightly different complicated hashes' );
is @Test::More::Data_Stack, 0;
-is( Test::Builder->new, Test::More->builder, 'builder()' );
+is( Test::Builder->new, Test::More->builder, 'builder()' );
cmp_ok(42, '==', 42, 'cmp_ok ==');
diff --git a/cpan/Test-Simple/t/Legacy/PerlIO.t b/cpan/Test-Simple/t/Legacy/PerlIO.t
new file mode 100644
index 0000000000..84ba649b37
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/PerlIO.t
@@ -0,0 +1,11 @@
+use Test::More;
+require PerlIO;
+
+my $ok = 1;
+my %counts;
+for my $layer (PerlIO::get_layers(Test::Stream->shared->io_sets->{legacy}->[0])) {
+ my $dup = $counts{$layer}++;
+ ok(!$dup, "No IO layer duplication '$layer'");
+}
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Simple/load.t b/cpan/Test-Simple/t/Legacy/Simple/load.t
index 938569a5b8..938569a5b8 100644
--- a/cpan/Test-Simple/t/Simple/load.t
+++ b/cpan/Test-Simple/t/Legacy/Simple/load.t
diff --git a/cpan/Test-Simple/t/Legacy/TestTester/auto.t b/cpan/Test-Simple/t/Legacy/TestTester/auto.t
new file mode 100644
index 0000000000..45510f3f06
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/TestTester/auto.t
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use Test::Tester tests => 4;
+
+use SmallTest;
+
+use MyTest;
+
+{
+ my ($prem, @results) = run_tests(sub { MyTest::ok(1, "run pass") });
+
+ is_eq($results[0]->{name}, "run pass");
+ is_num($results[0]->{ok}, 1);
+}
+
+{
+ my ($prem, @results) = run_tests(sub { MyTest::ok(0, "run fail") });
+
+ is_eq($results[0]->{name}, "run fail");
+ is_num($results[0]->{ok}, 0);
+}
diff --git a/cpan/Test-Simple/t/Legacy/TestTester/check_tests.t b/cpan/Test-Simple/t/Legacy/TestTester/check_tests.t
new file mode 100644
index 0000000000..96b8470329
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/TestTester/check_tests.t
@@ -0,0 +1,116 @@
+use strict;
+
+use Test::Tester;
+
+use Data::Dumper qw(Dumper);
+
+my $test = Test::Builder->new;
+$test->plan(tests => 105);
+
+my $cap;
+
+$cap = $test;
+
+my @tests = (
+ [
+ 'pass',
+ '$cap->ok(1, "pass");',
+ {
+ name => "pass",
+ ok => 1,
+ actual_ok => 1,
+ reason => "",
+ type => "",
+ diag => "",
+ depth => 0,
+ },
+ ],
+ [
+ 'pass diag',
+ '$cap->ok(1, "pass diag");
+ $cap->diag("pass diag1");
+ $cap->diag("pass diag2");',
+ {
+ name => "pass diag",
+ ok => 1,
+ actual_ok => 1,
+ reason => "",
+ type => "",
+ diag => "pass diag1\npass diag2\n",
+ depth => 0,
+ },
+ ],
+ [
+ 'pass diag no \\n',
+ '$cap->ok(1, "pass diag");
+ $cap->diag("pass diag1");
+ $cap->diag("pass diag2");',
+ {
+ name => "pass diag",
+ ok => 1,
+ actual_ok => 1,
+ reason => "",
+ type => "",
+ diag => "pass diag1\npass diag2",
+ depth => 0,
+ },
+ ],
+ [
+ 'fail',
+ '$cap->ok(0, "fail");
+ $cap->diag("fail diag");',
+ {
+ name => "fail",
+ ok => 0,
+ actual_ok => 0,
+ reason => "",
+ type => "",
+ diag => "fail diag\n",
+ depth => 0,
+ },
+ ],
+ [
+ 'skip',
+ '$cap->skip("just because");',
+ {
+ name => "",
+ ok => 1,
+ actual_ok => 1,
+ reason => "just because",
+ type => "skip",
+ diag => "",
+ depth => 0,
+ },
+ ],
+ [
+ 'todo_skip',
+ '$cap->todo_skip("why not");',
+ {
+ name => "",
+ ok => 1,
+ actual_ok => 0,
+ reason => "why not",
+ type => "todo_skip",
+ diag => "",
+ depth => 0,
+ },
+ ],
+);
+
+my $big_code = "";
+my @big_expect;
+
+foreach my $test (@tests) {
+ my ($name, $code, $expect) = @$test;
+
+ $big_code .= "$code\n";
+ push(@big_expect, $expect);
+
+ my $test_sub = eval "sub {$code}";
+
+ check_test($test_sub, $expect, $name);
+}
+
+my $big_test_sub = eval "sub {$big_code}";
+
+check_tests($big_test_sub, \@big_expect, "run all");
diff --git a/cpan/Test-Simple/t/Legacy/TestTester/depth.t b/cpan/Test-Simple/t/Legacy/TestTester/depth.t
new file mode 100644
index 0000000000..53ba7e0779
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/TestTester/depth.t
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use Test::Tester;
+
+use MyTest;
+
+my $test = Test::Builder->new;
+$test->plan(tests => 2);
+
+sub deeper
+{
+ MyTest::ok(1);
+}
+
+{
+
+ my @results = run_tests(
+ sub {
+ MyTest::ok(1);
+ deeper();
+ }
+ );
+
+ local $Test::Builder::Level = 0;
+ $test->is_num($results[1]->{depth}, 1, "depth 1");
+ $test->is_num($results[2]->{depth}, 2, "deeper");
+}
+
diff --git a/cpan/Test-Simple/t/Legacy/TestTester/is_bug.t b/cpan/Test-Simple/t/Legacy/TestTester/is_bug.t
new file mode 100644
index 0000000000..64642fca2a
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/TestTester/is_bug.t
@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+use Test::Tester;
+use Test::More;
+
+check_test(
+ sub { is "Foo", "Foo" },
+ {ok => 1},
+);
+
+check_test(
+ sub { is "Bar", "Bar" },
+ {ok => 1},
+);
+
+check_test(
+ sub { is "Baz", "Quux" },
+ {ok => 0},
+);
+
+check_test(
+ sub { like "Baz", qr/uhg/ },
+ {ok => 0},
+);
+
+check_test(
+ sub { like "Baz", qr/a/ },
+ {ok => 1},
+);
+
+done_testing();
diff --git a/cpan/Test-Simple/t/Legacy/TestTester/run_test.t b/cpan/Test-Simple/t/Legacy/TestTester/run_test.t
new file mode 100644
index 0000000000..6b1464c358
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/TestTester/run_test.t
@@ -0,0 +1,145 @@
+use strict;
+
+use Test::Tester;
+
+use Data::Dumper qw(Dumper);
+
+my $test = Test::Builder->new;
+$test->plan(tests => 54);
+
+my $cap;
+
+{
+ $cap = $test;
+ my ($prem, @results) = run_tests(
+ sub {$cap->ok(1, "run pass")}
+ );
+
+ local $Test::Builder::Level = 0;
+
+ $test->is_eq($prem, "", "run pass no prem");
+ $test->is_num(scalar (@results), 1, "run pass result count");
+
+ my $res = $results[0];
+
+ $test->is_eq($res->{name}, "run pass", "run pass name");
+ $test->is_eq($res->{ok}, 1, "run pass ok");
+ $test->is_eq($res->{actual_ok}, 1, "run pass actual_ok");
+ $test->is_eq($res->{reason}, "", "run pass reason");
+ $test->is_eq($res->{type}, "", "run pass type");
+ $test->is_eq($res->{diag}, "", "run pass diag");
+ $test->is_num($res->{depth}, 0, "run pass depth");
+}
+
+{
+ my ($prem, @results) = run_tests(
+ sub {$cap->ok(0, "run fail")}
+ );
+
+ local $Test::Builder::Level = 0;
+
+ $test->is_eq($prem, "", "run fail no prem");
+ $test->is_num(scalar (@results), 1, "run fail result count");
+
+ my $res = $results[0];
+
+ $test->is_eq($res->{name}, "run fail", "run fail name");
+ $test->is_eq($res->{actual_ok}, 0, "run fail actual_ok");
+ $test->is_eq($res->{ok}, 0, "run fail ok");
+ $test->is_eq($res->{reason}, "", "run fail reason");
+ $test->is_eq($res->{type}, "", "run fail type");
+ $test->is_eq($res->{diag}, "", "run fail diag");
+ $test->is_num($res->{depth}, 0, "run fail depth");
+}
+
+{
+ my ($prem, @results) = run_tests(
+ sub {$cap->skip("just because")}
+ );
+
+ local $Test::Builder::Level = 0;
+
+ $test->is_eq($prem, "", "skip no prem");
+ $test->is_num(scalar (@results), 1, "skip result count");
+
+ my $res = $results[0];
+
+ $test->is_eq($res->{name}, "", "skip name");
+ $test->is_eq($res->{actual_ok}, 1, "skip actual_ok");
+ $test->is_eq($res->{ok}, 1, "skip ok");
+ $test->is_eq($res->{reason}, "just because", "skip reason");
+ $test->is_eq($res->{type}, "skip", "skip type");
+ $test->is_eq($res->{diag}, "", "skip diag");
+ $test->is_num($res->{depth}, 0, "skip depth");
+}
+
+{
+ my ($prem, @results) = run_tests(
+ sub {$cap->todo_skip("just because")}
+ );
+
+ local $Test::Builder::Level = 0;
+
+ $test->is_eq($prem, "", "todo_skip no prem");
+ $test->is_num(scalar (@results), 1, "todo_skip result count");
+
+ my $res = $results[0];
+
+ $test->is_eq($res->{name}, "", "todo_skip name");
+ $test->is_eq($res->{actual_ok}, 0, "todo_skip actual_ok");
+ $test->is_eq($res->{ok}, 1, "todo_skip ok");
+ $test->is_eq($res->{reason}, "just because", "todo_skip reason");
+ $test->is_eq($res->{type}, "todo_skip", "todo_skip type");
+ $test->is_eq($res->{diag}, "", "todo_skip diag");
+ $test->is_num($res->{depth}, 0, "todo_skip depth");
+}
+
+{
+ my ($prem, @results) = run_tests(
+ sub {$cap->diag("run diag")}
+ );
+
+ local $Test::Builder::Level = 0;
+
+ $test->is_eq($prem, "run diag\n", "run diag prem");
+ $test->is_num(scalar (@results), 0, "run diag result count");
+}
+
+{
+ my ($prem, @results) = run_tests(
+ sub {
+ $cap->ok(1, "multi pass");
+ $cap->diag("multi pass diag1");
+ $cap->diag("multi pass diag2");
+ $cap->ok(0, "multi fail");
+ $cap->diag("multi fail diag");
+ }
+ );
+
+ local $Test::Builder::Level = 0;
+
+ $test->is_eq($prem, "", "run multi no prem");
+ $test->is_num(scalar (@results), 2, "run multi result count");
+
+ my $res_pass = $results[0];
+
+ $test->is_eq($res_pass->{name}, "multi pass", "run multi pass name");
+ $test->is_eq($res_pass->{actual_ok}, 1, "run multi pass actual_ok");
+ $test->is_eq($res_pass->{ok}, 1, "run multi pass ok");
+ $test->is_eq($res_pass->{reason}, "", "run multi pass reason");
+ $test->is_eq($res_pass->{type}, "", "run multi pass type");
+ $test->is_eq($res_pass->{diag}, "multi pass diag1\nmulti pass diag2\n",
+ "run multi pass diag");
+ $test->is_num($res_pass->{depth}, 0, "run multi pass depth");
+
+ my $res_fail = $results[1];
+
+ $test->is_eq($res_fail->{name}, "multi fail", "run multi fail name");
+ $test->is_eq($res_pass->{actual_ok}, 1, "run multi fail actual_ok");
+ $test->is_eq($res_fail->{ok}, 0, "run multi fail ok");
+ $test->is_eq($res_pass->{reason}, "", "run multi fail reason");
+ $test->is_eq($res_pass->{type}, "", "run multi fail type");
+ $test->is_eq($res_fail->{diag}, "multi fail diag\n", "run multi fail diag");
+ $test->is_num($res_pass->{depth}, 0, "run multi fail depth");
+}
+
diff --git a/cpan/Test-Simple/t/Tester/tbt_01basic.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_01basic.t
index 62820741c2..1b4b556d3f 100644
--- a/cpan/Test-Simple/t/Tester/tbt_01basic.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_01basic.t
@@ -51,7 +51,7 @@ test_test("testing failing on the same line with the same name");
test_out("not ok 1 - name # TODO Something");
test_out("# Failed (TODO) test ($0 at line 56)");
-TODO: {
+TODO: {
local $TODO = "Something";
fail("name");
}
diff --git a/cpan/Test-Simple/t/Tester/tbt_02fhrestore.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_02fhrestore.t
index e37357171b..c7826cdf1d 100644
--- a/cpan/Test-Simple/t/Tester/tbt_02fhrestore.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_02fhrestore.t
@@ -7,9 +7,9 @@ use Symbol;
# create temporary file handles that still point indirectly
# to the right place
-my $orig_o = gensym;
+my $orig_o = gensym;
my $orig_t = gensym;
-my $orig_f = gensym;
+my $orig_f = gensym;
tie *$orig_o, "My::Passthru", \*STDOUT;
tie *$orig_t, "My::Passthru", \*STDERR;
diff --git a/cpan/Test-Simple/t/Tester/tbt_03die.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_03die.t
index b9dba801eb..b9dba801eb 100644
--- a/cpan/Test-Simple/t/Tester/tbt_03die.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_03die.t
diff --git a/cpan/Test-Simple/t/Tester/tbt_04line_num.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_04line_num.t
index 9e8365acbf..9e8365acbf 100644
--- a/cpan/Test-Simple/t/Tester/tbt_04line_num.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_04line_num.t
diff --git a/cpan/Test-Simple/t/Tester/tbt_05faildiag.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_05faildiag.t
index 59ad721240..59ad721240 100644
--- a/cpan/Test-Simple/t/Tester/tbt_05faildiag.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_05faildiag.t
diff --git a/cpan/Test-Simple/t/Tester/tbt_06errormess.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t
index b02b617293..f68cba4e42 100644
--- a/cpan/Test-Simple/t/Tester/tbt_06errormess.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t
@@ -64,7 +64,7 @@ sub my_test_test
my $text = shift;
local $^W = 0;
- # reset the outputs
+ # reset the outputs
$t->output($original_output_handle);
$t->failure_output($original_failure_handle);
$t->todo_output($original_todo_handle);
diff --git a/cpan/Test-Simple/t/Tester/tbt_07args.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t
index 9542d755f4..0e322128dc 100644
--- a/cpan/Test-Simple/t/Tester/tbt_07args.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t
@@ -64,7 +64,7 @@ sub my_test_test
my $text = shift;
local $^W = 0;
- # reset the outputs
+ # reset the outputs
$t->output($original_output_handle);
$t->failure_output($original_failure_handle);
$t->todo_output($original_todo_handle);
diff --git a/cpan/Test-Simple/t/Tester/tbt_08subtest.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_08subtest.t
index 6ec508f247..6ec508f247 100644
--- a/cpan/Test-Simple/t/Tester/tbt_08subtest.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_08subtest.t
diff --git a/cpan/Test-Simple/t/Tester/tbt_09do.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do.t
index a0c8b8e2e5..a0c8b8e2e5 100644
--- a/cpan/Test-Simple/t/Tester/tbt_09do.t
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do.t
diff --git a/cpan/Test-Simple/t/Tester/tbt_09do_script.pl b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do_script.pl
index 590a03b085..590a03b085 100644
--- a/cpan/Test-Simple/t/Tester/tbt_09do_script.pl
+++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do_script.pl
diff --git a/cpan/Test-Simple/t/bad_plan.t b/cpan/Test-Simple/t/Legacy/bad_plan.t
index 80e0e65bca..80e0e65bca 100644
--- a/cpan/Test-Simple/t/bad_plan.t
+++ b/cpan/Test-Simple/t/Legacy/bad_plan.t
diff --git a/cpan/Test-Simple/t/bail_out.t b/cpan/Test-Simple/t/Legacy/bail_out.t
index 5cdc1f9969..5cdc1f9969 100644
--- a/cpan/Test-Simple/t/bail_out.t
+++ b/cpan/Test-Simple/t/Legacy/bail_out.t
diff --git a/cpan/Test-Simple/t/buffer.t b/cpan/Test-Simple/t/Legacy/buffer.t
index 6039e4a6f7..6039e4a6f7 100644
--- a/cpan/Test-Simple/t/buffer.t
+++ b/cpan/Test-Simple/t/Legacy/buffer.t
diff --git a/cpan/Test-Simple/t/c_flag.t b/cpan/Test-Simple/t/Legacy/c_flag.t
index a33963415e..a33963415e 100644
--- a/cpan/Test-Simple/t/c_flag.t
+++ b/cpan/Test-Simple/t/Legacy/c_flag.t
diff --git a/cpan/Test-Simple/t/circular_data.t b/cpan/Test-Simple/t/Legacy/circular_data.t
index 2fd819e1f4..15eb6d406f 100644
--- a/cpan/Test-Simple/t/circular_data.t
+++ b/cpan/Test-Simple/t/Legacy/circular_data.t
@@ -59,7 +59,7 @@ ok( eq_array ([$s], [$r]) );
{
# rt.cpan.org 11623
- # Make sure the circular ref checks don't get confused by a reference
+ # Make sure the circular ref checks don't get confused by a reference
# which is simply repeating.
my $a = {};
my $b = {};
diff --git a/cpan/Test-Simple/t/cmp_ok.t b/cpan/Test-Simple/t/Legacy/cmp_ok.t
index c9b9f1bf65..07ed1a9f0b 100644
--- a/cpan/Test-Simple/t/cmp_ok.t
+++ b/cpan/Test-Simple/t/Legacy/cmp_ok.t
@@ -15,7 +15,7 @@ $TB->level(0);
sub try_cmp_ok {
my($left, $cmp, $right, $error) = @_;
-
+
my %expect;
if( $error ) {
$expect{ok} = 0;
@@ -33,7 +33,7 @@ sub try_cmp_ok {
eval { $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); };
$TB->is_num(!!$ok, !!$expect{ok}, " right return");
-
+
my $diag = $err->read;
if ($@) {
diff --git a/cpan/Test-Simple/t/dependents.t b/cpan/Test-Simple/t/Legacy/dependents.t
index 90e8938ebe..90e8938ebe 100644
--- a/cpan/Test-Simple/t/dependents.t
+++ b/cpan/Test-Simple/t/Legacy/dependents.t
diff --git a/cpan/Test-Simple/t/diag.t b/cpan/Test-Simple/t/Legacy/diag.t
index f5cb437d54..f5cb437d54 100644
--- a/cpan/Test-Simple/t/diag.t
+++ b/cpan/Test-Simple/t/Legacy/diag.t
diff --git a/cpan/Test-Simple/t/died.t b/cpan/Test-Simple/t/Legacy/died.t
index b4ee2fbbff..b4ee2fbbff 100644
--- a/cpan/Test-Simple/t/died.t
+++ b/cpan/Test-Simple/t/Legacy/died.t
diff --git a/cpan/Test-Simple/t/dont_overwrite_die_handler.t b/cpan/Test-Simple/t/Legacy/dont_overwrite_die_handler.t
index cf9f907438..51f4d08d4e 100644
--- a/cpan/Test-Simple/t/dont_overwrite_die_handler.t
+++ b/cpan/Test-Simple/t/Legacy/dont_overwrite_die_handler.t
@@ -16,5 +16,6 @@ BEGIN {
use Test::More tests => 2;
+$handler_called = 0;
ok !eval { die };
is $handler_called, 1, 'existing DIE handler not overridden';
diff --git a/cpan/Test-Simple/t/eq_set.t b/cpan/Test-Simple/t/Legacy/eq_set.t
index fbdc52db1f..202f3d3665 100644
--- a/cpan/Test-Simple/t/eq_set.t
+++ b/cpan/Test-Simple/t/Legacy/eq_set.t
@@ -23,7 +23,7 @@ ok( eq_set([1,2,[3]], [1,[3],2]) );
# bugs.perl.org 36354
my $ref = \2;
ok( eq_set( [$ref, "$ref", "$ref", $ref],
- ["$ref", $ref, $ref, "$ref"]
+ ["$ref", $ref, $ref, "$ref"]
) );
TODO: {
diff --git a/cpan/Test-Simple/t/exit.t b/cpan/Test-Simple/t/Legacy/exit.t
index 2b17ce06a8..8c9e16d162 100644
--- a/cpan/Test-Simple/t/exit.t
+++ b/cpan/Test-Simple/t/Legacy/exit.t
@@ -24,9 +24,6 @@ my $Orig_Dir = cwd;
my $Perl = File::Spec->rel2abs($^X);
if( $^O eq 'VMS' ) {
- # VMS can't use its own $^X in a system call until almost 5.8
- $Perl = "MCR $^X" if $] < 5.007003;
-
# Quiet noisy 'SYS$ABORT'
$Perl .= q{ -"I../lib"} if $ENV{PERL_CORE};
$Perl .= q{ -"Mvmsish=hushed"};
@@ -104,7 +101,7 @@ while( my($test_name, $exit_code) = each %Tests ) {
"(expected non-zero)");
}
else {
- $TB->is_num( $actual_exit, $Exit_Map{$exit_code},
+ $TB->is_num( $actual_exit, $Exit_Map{$exit_code},
"$test_name exited with $actual_exit ".
"(expected $Exit_Map{$exit_code})");
}
diff --git a/cpan/Test-Simple/t/explain.t b/cpan/Test-Simple/t/Legacy/explain.t
index cf2f550e95..cf2f550e95 100644
--- a/cpan/Test-Simple/t/explain.t
+++ b/cpan/Test-Simple/t/Legacy/explain.t
diff --git a/cpan/Test-Simple/t/extra.t b/cpan/Test-Simple/t/Legacy/extra.t
index 55a0007d49..28febc3600 100644
--- a/cpan/Test-Simple/t/extra.t
+++ b/cpan/Test-Simple/t/Legacy/extra.t
@@ -14,7 +14,7 @@ use strict;
use Test::Builder;
use Test::Builder::NoOutput;
-use Test::Simple;
+use Test::More;
my $TB = Test::Builder->new;
my $test = Test::Builder::NoOutput->create;
@@ -51,10 +51,13 @@ not ok 5 - Sar
# at $0 line 45.
END
-$test->_ending();
-$TB->is_eq($test->read(), <<END);
+SKIP: {
+ skip 'Broken with new stuff' => 1;
+ $test->_ending();
+ $TB->is_eq($test->read(), <<' END');
# Looks like you planned 3 tests but ran 5.
# Looks like you failed 2 tests of 5 run.
-END
+ END
+}
$TB->done_testing(5);
diff --git a/cpan/Test-Simple/t/extra_one.t b/cpan/Test-Simple/t/Legacy/extra_one.t
index d77404e15d..d77404e15d 100644
--- a/cpan/Test-Simple/t/extra_one.t
+++ b/cpan/Test-Simple/t/Legacy/extra_one.t
diff --git a/cpan/Test-Simple/t/fail-like.t b/cpan/Test-Simple/t/Legacy/fail-like.t
index 0383094913..19e748f567 100644
--- a/cpan/Test-Simple/t/fail-like.t
+++ b/cpan/Test-Simple/t/Legacy/fail-like.t
@@ -22,7 +22,7 @@ package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
-my $TB = Test::Builder->create;
+my $TB = Test::Builder->create();
$TB->plan(tests => 4);
@@ -71,7 +71,5 @@ OUT
}
-END {
- # Test::More thinks it failed. Override that.
- exit(scalar grep { !$_ } $TB->summary);
-}
+# Test::More thinks it failed. Override that.
+Test::Builder->new->no_ending(1);
diff --git a/cpan/Test-Simple/t/fail-more.t b/cpan/Test-Simple/t/Legacy/fail-more.t
index 5c35d49bd3..aab2d83031 100644
--- a/cpan/Test-Simple/t/fail-more.t
+++ b/cpan/Test-Simple/t/Legacy/fail-more.t
@@ -27,19 +27,23 @@ my $TB = Test::Builder->create;
$TB->plan(tests => 80);
sub like ($$;$) {
+ my $c = Test::Stream::Context::context();
$TB->like(@_);
}
sub is ($$;$) {
+ my $c = Test::Stream::Context::context();
$TB->is_eq(@_);
}
sub main::out_ok ($$) {
+ my $c = Test::Stream::Context::context();
$TB->is_eq( $out->read, shift );
$TB->is_eq( $err->read, shift );
}
sub main::out_like ($$) {
+ my $c = Test::Stream::Context::context();
my($output, $failure) = @_;
$TB->like( $out->read, qr/$output/ );
@@ -233,7 +237,8 @@ not ok - ARRAY->can('foo')
OUT
# Failed test 'ARRAY->can('foo')'
# at $0 line 228.
-# ARRAY->can('foo') failed
+# ARRAY->can('foo') failed with an exception:
+# Can't call method "can" on unblessed reference.
ERR
#line 238
@@ -243,7 +248,7 @@ not ok - An object of class 'Foo' isa 'Wibble'
OUT
# Failed test 'An object of class 'Foo' isa 'Wibble''
# at $0 line 238.
-# The object of class 'Foo' isn't a 'Wibble'
+# An object of class 'Foo' isn't a 'Wibble'
ERR
#line 248
@@ -283,7 +288,7 @@ not ok - A reference of type 'ARRAY' isa 'HASH'
OUT
# Failed test 'A reference of type 'ARRAY' isa 'HASH''
# at $0 line 268.
-# The reference of type 'ARRAY' isn't a 'HASH'
+# A reference of type 'ARRAY' isn't a 'HASH'
ERR
#line 278
@@ -328,7 +333,7 @@ not ok - A reference of type 'HASH' isa 'Bar'
OUT
# Failed test 'A reference of type 'HASH' isa 'Bar''
# at $0 line 313.
-# The reference of type 'HASH' isn't a 'Bar'
+# A reference of type 'HASH' isn't a 'Bar'
ERR
#line 323
@@ -338,7 +343,7 @@ not ok - An object of class 'Wibble' isa 'Baz'
OUT
# Failed test 'An object of class 'Wibble' isa 'Baz''
# at $0 line 323.
-# The object of class 'Wibble' isn't a 'Baz'
+# An object of class 'Wibble' isn't a 'Baz'
ERR
#line 333
diff --git a/cpan/Test-Simple/t/fail.t b/cpan/Test-Simple/t/Legacy/fail.t
index ccf0c74893..ccf0c74893 100644
--- a/cpan/Test-Simple/t/fail.t
+++ b/cpan/Test-Simple/t/Legacy/fail.t
diff --git a/cpan/Test-Simple/t/fail_one.t b/cpan/Test-Simple/t/Legacy/fail_one.t
index 61d7c081ff..61d7c081ff 100644
--- a/cpan/Test-Simple/t/fail_one.t
+++ b/cpan/Test-Simple/t/Legacy/fail_one.t
diff --git a/cpan/Test-Simple/t/filehandles.t b/cpan/Test-Simple/t/Legacy/filehandles.t
index f7dad5d7ea..f7dad5d7ea 100644
--- a/cpan/Test-Simple/t/filehandles.t
+++ b/cpan/Test-Simple/t/Legacy/filehandles.t
diff --git a/cpan/Test-Simple/t/fork.t b/cpan/Test-Simple/t/Legacy/fork.t
index 55d7aec1f9..fd895b450f 100644
--- a/cpan/Test-Simple/t/fork.t
+++ b/cpan/Test-Simple/t/Legacy/fork.t
@@ -12,7 +12,7 @@ use Config;
my $Can_Fork = $Config{d_fork} ||
(($^O eq 'MSWin32' || $^O eq 'NetWare') and
- $Config{useithreads} and
+ $Config{useithreads} and
$Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
);
@@ -23,8 +23,10 @@ else {
plan tests => 1;
}
-if( fork ) { # parent
+my $pid = fork;
+if( $pid ) { # parent
pass("Only the parent should process the ending, not the child");
+ waitpid($pid, 0);
}
else {
exit; # child
diff --git a/cpan/Test-Simple/t/Legacy/fork_in_subtest.t b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
new file mode 100644
index 0000000000..3ed851a638
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+
+use Config;
+
+BEGIN {
+ my $Can_Fork = $Config{d_fork} ||
+ (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+ $Config{useithreads} and
+ $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+ );
+
+ unless( $Can_Fork ) {
+ require Test::More;
+ Test::More::plan(skip_all => "This system cannot fork");
+ exit 0;
+ }
+}
+
+use Test::Stream;
+use Test::More;
+# This just goes to show how silly forking inside a subtest would actually
+# be....
+
+ok(1, "fine $$");
+
+my $pid;
+subtest my_subtest => sub {
+ ok(1, "inside 1 | $$");
+ $pid = fork();
+ ok(1, "inside 2 | $$");
+};
+
+if($pid) {
+ waitpid($pid, 0);
+
+ ok(1, "after $$");
+
+ done_testing;
+}
diff --git a/cpan/Test-Simple/t/harness_active.t b/cpan/Test-Simple/t/Legacy/harness_active.t
index 7b027a7b40..bda5dae318 100644
--- a/cpan/Test-Simple/t/harness_active.t
+++ b/cpan/Test-Simple/t/Legacy/harness_active.t
@@ -66,7 +66,7 @@ ERR
{
local $ENV{HARNESS_ACTIVE} = 1;
-
+
#line 71
fail( "this fails" );
err_ok( <<ERR );
diff --git a/cpan/Test-Simple/t/import.t b/cpan/Test-Simple/t/Legacy/import.t
index 68a36138bc..68a36138bc 100644
--- a/cpan/Test-Simple/t/import.t
+++ b/cpan/Test-Simple/t/Legacy/import.t
diff --git a/cpan/Test-Simple/t/is_deeply_dne_bug.t b/cpan/Test-Simple/t/Legacy/is_deeply_dne_bug.t
index f4578a6460..f4578a6460 100644
--- a/cpan/Test-Simple/t/is_deeply_dne_bug.t
+++ b/cpan/Test-Simple/t/Legacy/is_deeply_dne_bug.t
diff --git a/cpan/Test-Simple/t/is_deeply_fail.t b/cpan/Test-Simple/t/Legacy/is_deeply_fail.t
index 26036fb960..b955d290f4 100644
--- a/cpan/Test-Simple/t/is_deeply_fail.t
+++ b/cpan/Test-Simple/t/Legacy/is_deeply_fail.t
@@ -83,7 +83,7 @@ ERR
#line 88
ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
-is( $out, "not ok 3 - hashes with different values\n",
+is( $out, "not ok 3 - hashes with different values\n",
'hashes with different values' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'hashes with different values'
@@ -223,7 +223,7 @@ foreach my $test (@tests) {
local $SIG{__WARN__} = sub { $warning .= join '', @_; };
ok !is_deeply(@$test);
- like \$warning,
+ like \$warning,
"/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/";
}
diff --git a/cpan/Test-Simple/t/is_deeply_with_threads.t b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
index 9908ef6608..66a6641fa7 100644
--- a/cpan/Test-Simple/t/is_deeply_with_threads.t
+++ b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
@@ -16,18 +16,27 @@ use strict;
use Config;
BEGIN {
- unless ( $] >= 5.008001 && $Config{'useithreads'} &&
- eval { require threads; 'threads'->import; 1; })
- {
+ if ($] == 5.010000) {
+ print "1..0 # Threads are broken on 5.10.0\n";
+ exit 0;
+ }
+
+ my $works = 1;
+ $works &&= $] >= 5.008001;
+ $works &&= $Config{'useithreads'};
+ $works &&= eval { require threads; 'threads'->import; 1 };
+
+ unless ($works) {
print "1..0 # Skip no working threads\n";
exit 0;
}
-
+
unless ( $ENV{AUTHOR_TESTING} ) {
print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
exit 0;
}
}
+
use Test::More;
my $Num_Threads = 5;
diff --git a/cpan/Test-Simple/t/missing.t b/cpan/Test-Simple/t/Legacy/missing.t
index 3996b6de4b..3996b6de4b 100644
--- a/cpan/Test-Simple/t/missing.t
+++ b/cpan/Test-Simple/t/Legacy/missing.t
diff --git a/cpan/Test-Simple/t/new_ok.t b/cpan/Test-Simple/t/Legacy/new_ok.t
index d53f535d1c..2579e67218 100644
--- a/cpan/Test-Simple/t/new_ok.t
+++ b/cpan/Test-Simple/t/Legacy/new_ok.t
@@ -39,4 +39,6 @@ use Test::More tests => 13;
eval {
new_ok();
};
-is $@, sprintf "new_ok() must be given at least a class at %s line %d.\n", $0, __LINE__ - 2;
+my $error = $@;
+$error =~ s/\.?\n.*$//gsm;
+is $error, sprintf "new_ok() must be given at least a class at %s line %d", $0, __LINE__ - 4;
diff --git a/cpan/Test-Simple/t/no_plan.t b/cpan/Test-Simple/t/Legacy/no_plan.t
index 5f392e40e1..5f392e40e1 100644
--- a/cpan/Test-Simple/t/no_plan.t
+++ b/cpan/Test-Simple/t/Legacy/no_plan.t
diff --git a/cpan/Test-Simple/t/no_tests.t b/cpan/Test-Simple/t/Legacy/no_tests.t
index eafa38cacc..eafa38cacc 100644
--- a/cpan/Test-Simple/t/no_tests.t
+++ b/cpan/Test-Simple/t/Legacy/no_tests.t
diff --git a/cpan/Test-Simple/t/note.t b/cpan/Test-Simple/t/Legacy/note.t
index fb98fb4029..fb98fb4029 100644
--- a/cpan/Test-Simple/t/note.t
+++ b/cpan/Test-Simple/t/Legacy/note.t
diff --git a/cpan/Test-Simple/t/overload.t b/cpan/Test-Simple/t/Legacy/overload.t
index a86103746b..fe9bc46e5a 100644
--- a/cpan/Test-Simple/t/overload.t
+++ b/cpan/Test-Simple/t/Legacy/overload.t
@@ -69,7 +69,7 @@ Test::More->builder->is_eq ($obj, "foo");
package Foo;
::is_deeply(['TestPackage'], ['TestPackage']);
- ::is_deeply({'TestPackage' => 'TestPackage'},
+ ::is_deeply({'TestPackage' => 'TestPackage'},
{'TestPackage' => 'TestPackage'});
::is_deeply('TestPackage', 'TestPackage');
}
diff --git a/cpan/Test-Simple/t/overload_threads.t b/cpan/Test-Simple/t/Legacy/overload_threads.t
index 379e347bae..379e347bae 100644
--- a/cpan/Test-Simple/t/overload_threads.t
+++ b/cpan/Test-Simple/t/Legacy/overload_threads.t
diff --git a/cpan/Test-Simple/t/plan.t b/cpan/Test-Simple/t/Legacy/plan.t
index 0d3ce89edb..2b6b2fdc78 100644
--- a/cpan/Test-Simple/t/plan.t
+++ b/cpan/Test-Simple/t/Legacy/plan.t
@@ -11,10 +11,10 @@ use Test::More;
plan tests => 4;
eval { plan tests => 4 };
-is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1),
+is( $@, sprintf("Tried to plan twice!\n %s line %d\n %s line %d\n", $0, __LINE__ - 2, $0, __LINE__ - 1),
'disallow double plan' );
eval { plan 'no_plan' };
-is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1),
+is( $@, sprintf("Tried to plan twice!\n %s line %d\n %s line %d\n", $0, __LINE__ - 5, $0, __LINE__ - 1),
'disallow changing plan' );
pass('Just testing plan()');
diff --git a/cpan/Test-Simple/t/plan_bad.t b/cpan/Test-Simple/t/Legacy/plan_bad.t
index 179356dbc1..179356dbc1 100644
--- a/cpan/Test-Simple/t/plan_bad.t
+++ b/cpan/Test-Simple/t/Legacy/plan_bad.t
diff --git a/cpan/Test-Simple/t/plan_is_noplan.t b/cpan/Test-Simple/t/Legacy/plan_is_noplan.t
index 1e696042ef..1e696042ef 100644
--- a/cpan/Test-Simple/t/plan_is_noplan.t
+++ b/cpan/Test-Simple/t/Legacy/plan_is_noplan.t
diff --git a/cpan/Test-Simple/t/plan_no_plan.t b/cpan/Test-Simple/t/Legacy/plan_no_plan.t
index 3111592e97..59fab4d21c 100644
--- a/cpan/Test-Simple/t/plan_no_plan.t
+++ b/cpan/Test-Simple/t/Legacy/plan_no_plan.t
@@ -8,6 +8,10 @@ BEGIN {
use Test::More;
BEGIN {
+ require warnings;
+ if( eval "warnings->can('carp')" ) {
+ plan skip_all => 'Modern::Open is installed, which breaks this test';
+ }
if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) {
plan skip_all => "Won't work with t/TEST";
}
diff --git a/cpan/Test-Simple/t/plan_shouldnt_import.t b/cpan/Test-Simple/t/Legacy/plan_shouldnt_import.t
index b6eb064244..b6eb064244 100644
--- a/cpan/Test-Simple/t/plan_shouldnt_import.t
+++ b/cpan/Test-Simple/t/Legacy/plan_shouldnt_import.t
diff --git a/cpan/Test-Simple/t/plan_skip_all.t b/cpan/Test-Simple/t/Legacy/plan_skip_all.t
index 528df5f50d..528df5f50d 100644
--- a/cpan/Test-Simple/t/plan_skip_all.t
+++ b/cpan/Test-Simple/t/Legacy/plan_skip_all.t
diff --git a/cpan/Test-Simple/t/Legacy/pod.t b/cpan/Test-Simple/t/Legacy/pod.t
new file mode 100644
index 0000000000..ac55c162df
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/pod.t
@@ -0,0 +1,7 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+plan skip_all => "POD tests skipped unless AUTHOR_TESTING is set" unless $ENV{AUTHOR_TESTING};
+my $test_pod = eval "use Test::Pod 1.00; 1";
+plan skip_all => "Test::Pod 1.00 required for testing POD" unless $test_pod;
+all_pod_files_ok();
diff --git a/cpan/Test-Simple/t/require_ok.t b/cpan/Test-Simple/t/Legacy/require_ok.t
index 463a007599..56d01bc108 100644
--- a/cpan/Test-Simple/t/require_ok.t
+++ b/cpan/Test-Simple/t/Legacy/require_ok.t
@@ -11,7 +11,7 @@ BEGIN {
}
use strict;
-use Test::More tests => 8;
+use Test::More tests => 4;
# Symbol and Class::Struct are both non-XS core modules back to 5.004.
# So they'll always be there.
@@ -20,10 +20,3 @@ ok( $INC{'Symbol.pm'}, "require_ok MODULE" );
require_ok("Class/Struct.pm");
ok( $INC{'Class/Struct.pm'}, "require_ok FILE" );
-
-# Its more trouble than its worth to try to create these filepaths to test
-# through require_ok() so we cheat and use the internal logic.
-ok !Test::More::_is_module_name('foo:bar');
-ok !Test::More::_is_module_name('foo/bar.thing');
-ok !Test::More::_is_module_name('Foo::Bar::');
-ok Test::More::_is_module_name('V');
diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_diag.t b/cpan/Test-Simple/t/Legacy/ribasushi_diag.t
new file mode 100644
index 0000000000..570ee5159b
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/ribasushi_diag.t
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ my $has_module = eval { require SQL::Abstract::Test; 1 };
+ my $required = $ENV{AUTHOR_TESTING};
+
+ if ($required && !$has_module) {
+ die "This test requires 'SQL::Abstract::Test' to be installed when AUTHOR_TESTING.\n";
+ }
+
+ unless($required) {
+ plan skip_all => "Only run when AUTHOR_TESTING is set";
+ }
+}
+
+{
+ package Worker;
+
+ sub do_work {
+ local $Test::Builder::Level = $Test::Builder::Level + 2;
+ shift->();
+ }
+}
+
+use SQL::Abstract::Test;
+use Test::Stream::Tester;
+
+my $events = intercept {
+ local $TODO = "Not today";
+
+ Worker::do_work(
+ sub {
+ SQL::Abstract::Test::is_same_sql_bind(
+ 'buh', [],
+ 'bah', [1],
+ );
+ }
+ );
+};
+
+ok( !(grep { $_->context->in_todo ? 0 : 1 } @{$events->[0]->diag}), "All diag is todo" );
+
+events_are(
+ $events,
+ check {
+ event ok => {
+ in_todo => 1,
+ };
+ event note => { in_todo => 1 };
+ event note => { in_todo => 1 };
+ dir 'end';
+ },
+ "All events are TODO"
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
new file mode 100644
index 0000000000..32a7d1f0ae
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
@@ -0,0 +1,77 @@
+use Config;
+
+BEGIN {
+ if ($] == 5.010000) {
+ print "1..0 # Threads are broken on 5.10.0\n";
+ exit 0;
+ }
+
+ my $works = 1;
+ $works &&= $] >= 5.008001;
+ $works &&= $Config{'useithreads'};
+ $works &&= eval { require threads; 'threads'->import; 1 };
+
+ unless ($works) {
+ print "1..0 # Skip no working threads\n";
+ exit 0;
+ }
+
+ unless ($ENV{AUTHOR_TESTING}) {
+ print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
+ exit 0;
+ }
+
+ if ($INC{'Devel/Cover.pm'}) {
+ print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
+ exit 0;
+ }
+}
+
+use threads;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+# basic tests
+{
+ pass('Test starts');
+ my $ct_num = Test::More->builder->current_test;
+
+ my $newthread = async {
+ my $out = '';
+
+ #simulate a subtest to not confuse the parent TAP emission
+ my $tb = Test::More->builder;
+ $tb->reset;
+
+ Test::More->builder->current_test(0);
+ for (qw/output failure_output todo_output/) {
+ close $tb->$_;
+ open($tb->$_, '>', \$out);
+ }
+
+ pass("In-thread ok") for (1, 2, 3);
+
+ done_testing;
+
+ close $tb->$_ for (qw/output failure_output todo_output/);
+ sleep(1); # tasty crashes without this
+
+ $out;
+ };
+ die "Thread creation failed: $! $@" if !defined $newthread;
+
+ my $out = $newthread->join;
+ $out =~ s/^/ /gm;
+
+ print $out;
+
+ # workaround for older Test::More confusing the plan under threads
+ Test::More->builder->current_test($ct_num);
+
+ pass("Made it to the end");
+}
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
new file mode 100644
index 0000000000..c60c61e650
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
@@ -0,0 +1,51 @@
+use Config;
+
+BEGIN {
+ if ($] == 5.010000) {
+ print "1..0 # Threads are broken on 5.10.0\n";
+ exit 0;
+ }
+
+ my $works = 1;
+ $works &&= $] >= 5.008001;
+ $works &&= $Config{'useithreads'};
+ $works &&= eval { require threads; 'threads'->import; 1 };
+
+ unless ($works) {
+ print "1..0 # Skip no working threads\n";
+ exit 0;
+ }
+
+ unless ($ENV{AUTHOR_TESTING}) {
+ print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
+ exit 0;
+ }
+
+ if ($INC{'Devel/Cover.pm'}) {
+ print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
+ exit 0;
+ }
+}
+
+use threads;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+ my $todo = sub {
+ my $out;
+ ok(1);
+ 42;
+ };
+
+ is(
+ threads->create($todo)->join,
+ 42,
+ "Correct result after do-er",
+ );
+}
+
+done_testing;
diff --git a/cpan/Test-Simple/t/simple.t b/cpan/Test-Simple/t/Legacy/simple.t
index 7297e9d6dd..7297e9d6dd 100644
--- a/cpan/Test-Simple/t/simple.t
+++ b/cpan/Test-Simple/t/Legacy/simple.t
diff --git a/cpan/Test-Simple/t/skip.t b/cpan/Test-Simple/t/Legacy/skip.t
index f2ea9fbf20..df4d6e163a 100644
--- a/cpan/Test-Simple/t/skip.t
+++ b/cpan/Test-Simple/t/Legacy/skip.t
@@ -7,14 +7,21 @@ BEGIN {
}
}
-use Test::More tests => 17;
+use Test::More;
+
+BEGIN {
+ require warnings;
+ if( eval "warnings->can('carp')" ) {
+ plan skip_all => 'Modern::Open is installed, which breaks this test';
+ }
+}
# If we skip with the same name, Test::Harness will report it back and
# we won't get lots of false bug reports.
my $Why = "Just testing the skip interface.";
SKIP: {
- skip $Why, 2
+ skip $Why, 2
unless Pigs->can('fly');
my $pig = Pigs->new;
@@ -64,7 +71,7 @@ SKIP: {
fail("So very failed");
}
is( $warning, "skip() needs to know \$how_many tests are in the ".
- "block at $0 line 56\n",
+ "block at $0 line 56.\n",
'skip without $how_many warning' );
}
@@ -96,3 +103,5 @@ SKIP: {
like $warning, qr/^skip\(\) was passed a non-numeric number of tests/;
}
+
+done_testing;
diff --git a/cpan/Test-Simple/t/skipall.t b/cpan/Test-Simple/t/Legacy/skipall.t
index 5491be126e..08c8543be2 100644
--- a/cpan/Test-Simple/t/skipall.t
+++ b/cpan/Test-Simple/t/Legacy/skipall.t
@@ -8,7 +8,7 @@ BEGIN {
else {
unshift @INC, 't/lib';
}
-}
+}
use strict;
diff --git a/cpan/Test-Simple/t/Legacy/strays.t b/cpan/Test-Simple/t/Legacy/strays.t
new file mode 100644
index 0000000000..02a99ab996
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/strays.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+# Check that stray newlines in test output are properly handed.
+
+BEGIN {
+ print "1..0 # Skip not completed\n";
+ exit 0;
+}
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+chdir 't';
+
+use Test::Builder::NoOutput;
+my $tb = Test::Builder::NoOutput->create;
+
+$tb->ok(1, "name\n");
+$tb->ok(0, "foo\nbar\nbaz");
+$tb->skip("\nmoofer");
+$tb->todo_skip("foo\n\n");
diff --git a/cpan/Test-Simple/t/subtest/args.t b/cpan/Test-Simple/t/Legacy/subtest/args.t
index 8ae26baa93..d43ac5288e 100644
--- a/cpan/Test-Simple/t/subtest/args.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/args.t
@@ -22,6 +22,7 @@ $tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ );
$tb->ok( !eval { $tb->subtest("foo") } );
$tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ );
+use Carp qw/confess/;
$tb->subtest('Arg passing', sub {
my $foo = shift;
my $child = Test::Builder->new;
diff --git a/cpan/Test-Simple/t/subtest/bail_out.t b/cpan/Test-Simple/t/Legacy/subtest/bail_out.t
index 70dc9ac56f..d6b074c2cf 100644
--- a/cpan/Test-Simple/t/subtest/bail_out.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/bail_out.t
@@ -12,7 +12,7 @@ BEGIN {
my $Exit_Code;
BEGIN {
- *CORE::GLOBAL::exit = sub { $Exit_Code = shift; };
+ *CORE::GLOBAL::exit = sub { $Exit_Code = shift; die };
}
use Test::Builder;
@@ -30,29 +30,34 @@ $Test->plan(tests => 2);
plan tests => 4;
ok 'foo';
-subtest 'bar' => sub {
- plan tests => 3;
- ok 'sub_foo';
- subtest 'sub_bar' => sub {
+my $ok = eval {
+ subtest 'bar' => sub {
plan tests => 3;
- ok 'sub_sub_foo';
- ok 'sub_sub_bar';
- BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
- ok 'sub_sub_baz';
+ ok 'sub_foo';
+ subtest 'sub_bar' => sub {
+ plan tests => 3;
+ ok 'sub_sub_foo';
+ ok 'sub_sub_bar';
+ BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
+ ok 'sub_sub_baz';
+ };
+ ok 'sub_baz';
};
- ok 'sub_baz';
+ 1;
};
$Test->is_eq( $output, <<'OUT' );
1..4
ok 1
- # Subtest: bar
+# Subtest: bar
1..3
ok 1
- # Subtest: sub_bar
+ # Subtest: sub_bar
1..3
ok 1
ok 2
+ Bail out! ROCKS FALL! EVERYONE DIES!
+ Bail out! ROCKS FALL! EVERYONE DIES!
Bail out! ROCKS FALL! EVERYONE DIES!
OUT
diff --git a/cpan/Test-Simple/t/subtest/basic.t b/cpan/Test-Simple/t/Legacy/subtest/basic.t
index 93780a9da2..964b60d6bf 100644
--- a/cpan/Test-Simple/t/subtest/basic.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/basic.t
@@ -15,7 +15,7 @@ use warnings;
use Test::Builder::NoOutput;
-use Test::More tests => 19;
+use Test::More tests => 18;
# Formatting may change if we're running under Test::Harness.
$ENV{HARNESS_ACTIVE} = 0;
@@ -169,14 +169,12 @@ END
my $child = $tb->child('skippy says he loves you');
eval { $child->plan( skip_all => 'cuz I said so' ) };
ok my $error = $@, 'A child which does a "skip_all" should throw an exception';
- isa_ok $error, 'Test::Builder::Exception', '... and the exception it throws';
+ isa_ok $error, 'Test::Stream::Event', '... and the exception it throws';
}
subtest 'skip all', sub {
plan skip_all => 'subtest with skip_all';
ok 0, 'This should never be run';
};
- is +Test::Builder->new->{Test_Results}[-1]{type}, 'skip',
- 'Subtests which "skip_all" are reported as skipped tests';
}
# to do tests
@@ -207,7 +205,10 @@ END
$tb->_ending;
my $expected = <<"END";
1..1
-not ok 1 - No tests run for subtest "Child of $0"
+not ok 1 - Child of $0
+# Failed test 'Child of $0'
+# at $0 line 225.
+# No tests run for subtest.
END
like $tb->read, qr/\Q$expected/,
'Not running subtests should make the parent test fail';
diff --git a/cpan/Test-Simple/t/subtest/die.t b/cpan/Test-Simple/t/Legacy/subtest/die.t
index 7965e9088b..7965e9088b 100644
--- a/cpan/Test-Simple/t/subtest/die.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/die.t
diff --git a/cpan/Test-Simple/t/subtest/do.t b/cpan/Test-Simple/t/Legacy/subtest/do.t
index 40b950184e..b034893f63 100644
--- a/cpan/Test-Simple/t/subtest/do.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/do.t
@@ -7,7 +7,7 @@ use Test::More;
pass("First");
-my $file = "t/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 };
diff --git a/cpan/Test-Simple/t/subtest/exceptions.t b/cpan/Test-Simple/t/Legacy/subtest/exceptions.t
index 92d65b648a..c4e57a982f 100644
--- a/cpan/Test-Simple/t/subtest/exceptions.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/exceptions.t
@@ -17,11 +17,12 @@ use Test::More tests => 7;
{
my $tb = Test::Builder::NoOutput->create;
- $tb->child('one');
+ my $child = $tb->child('one');
eval { $tb->child('two') };
my $error = $@;
like $error, qr/\QYou already have a child named (one) running/,
'Trying to create a child with another one active should fail';
+ $child->finalize;
}
{
my $tb = Test::Builder::NoOutput->create;
@@ -31,14 +32,17 @@ use Test::More tests => 7;
my $error = $@;
like $error, qr/\QCan't call finalize() with child (two) active/,
'... but trying to finalize() a child with open children should fail';
+ $child2->finalize;
+ $child->finalize;
}
{
my $tb = Test::Builder::NoOutput->create;
my $child = $tb->child('one');
- undef $child;
- like $tb->read, qr/\QChild (one) exited without calling finalize()/,
+ eval { $child->DESTROY };
+ like $@, qr/\QChild (one) exited without calling finalize()/,
'Failing to call finalize should issue an appropriate diagnostic';
ok !$tb->is_passing, '... and should cause the test suite to fail';
+ $child->finalize;
}
{
my $tb = Test::Builder::NoOutput->create;
diff --git a/cpan/Test-Simple/t/subtest/for_do_t.test b/cpan/Test-Simple/t/Legacy/subtest/for_do_t.test
index 413923bceb..413923bceb 100644
--- a/cpan/Test-Simple/t/subtest/for_do_t.test
+++ b/cpan/Test-Simple/t/Legacy/subtest/for_do_t.test
diff --git a/cpan/Test-Simple/t/subtest/fork.t b/cpan/Test-Simple/t/Legacy/subtest/fork.t
index e072a4813e..0191e7894b 100644
--- a/cpan/Test-Simple/t/subtest/fork.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/fork.t
@@ -33,17 +33,17 @@ subtest 'fork within subtest' => sub {
is $?, 0, 'child exit status';
like $child_output, qr/^[\s#]+Child Done\s*\z/, 'child output';
- }
+ }
else {
$pipe->writer;
# Force all T::B output into the pipe, for the parent
# builder as well as the current subtest builder.
- no warnings 'redefine';
- *Test::Builder::output = sub { $pipe };
- *Test::Builder::failure_output = sub { $pipe };
- *Test::Builder::todo_output = sub { $pipe };
-
+ my $builder = Test::Builder->new;
+ $builder->output($pipe);
+ $builder->failure_output($pipe);
+ $builder->todo_output($pipe);
+
diag 'Child Done';
exit 0;
}
diff --git a/cpan/Test-Simple/t/subtest/implicit_done.t b/cpan/Test-Simple/t/Legacy/subtest/implicit_done.t
index 0963e72c59..0963e72c59 100644
--- a/cpan/Test-Simple/t/subtest/implicit_done.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/implicit_done.t
diff --git a/cpan/Test-Simple/t/subtest/line_numbers.t b/cpan/Test-Simple/t/Legacy/subtest/line_numbers.t
index 7a20a60ae6..cc9c10db4f 100644
--- a/cpan/Test-Simple/t/subtest/line_numbers.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/line_numbers.t
@@ -26,7 +26,7 @@ $ENV{HARNESS_ACTIVE} = 0;
our %line;
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1");
test_out(" not ok 2");
@@ -43,11 +43,11 @@ our %line;
ok 0; BEGIN{ $line{innerfail1} = __LINE__ }
ok 1;
}; BEGIN{ $line{outerfail1} = __LINE__ }
-
+
test_test("un-named inner tests");
}
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1 - first is good");
test_out(" not ok 2 - second is bad");
@@ -65,7 +65,7 @@ our %line;
ok 0, "second is bad"; BEGIN{ $line{innerfail2} = __LINE__ }
ok 1, "third is good";
}; BEGIN{ $line{outerfail2} = __LINE__ }
-
+
test_test("named inner tests");
}
@@ -78,7 +78,7 @@ sub run_the_subtest {
}; BEGIN{ $line{outerfail3} = __LINE__ }
}
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1 - first is good");
test_out(" not ok 2 - second is bad");
@@ -91,16 +91,17 @@ sub run_the_subtest {
test_err("# at $0 line $line{outerfail3}.");
run_the_subtest();
-
+
test_test("subtest() called from a sub");
}
{
- test_out( " # Subtest: namehere");
+ test_out( "# Subtest: namehere");
test_out( " 1..0");
test_err( " # No tests run!");
- test_out( 'not ok 1 - No tests run for subtest "namehere"');
- test_err(q{# Failed test 'No tests run for subtest "namehere"'});
+ test_out( 'not ok 1 - namehere');
+ test_err(q{# Failed test 'namehere'});
test_err( "# at $0 line $line{outerfail4}.");
+ test_err( "# No tests run for subtest.");
subtest namehere => sub {
done_testing;
@@ -109,7 +110,7 @@ sub run_the_subtest {
test_test("lineno in 'No tests run' diagnostic");
}
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..1");
test_out(" not ok 1 - foo is bar");
test_err(" # Failed test 'foo is bar'");
diff --git a/cpan/Test-Simple/t/subtest/plan.t b/cpan/Test-Simple/t/Legacy/subtest/plan.t
index 7e944ab283..7e944ab283 100644
--- a/cpan/Test-Simple/t/subtest/plan.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/plan.t
diff --git a/cpan/Test-Simple/t/subtest/predicate.t b/cpan/Test-Simple/t/Legacy/subtest/predicate.t
index 4e29a426b1..73b9c81056 100644
--- a/cpan/Test-Simple/t/subtest/predicate.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/predicate.t
@@ -40,7 +40,7 @@ sub foobar_ok ($;$) {
};
}
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
@@ -65,7 +65,7 @@ sub foobar_ok_2 ($;$) {
foobar_ok($value, $name);
}
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
@@ -95,7 +95,7 @@ sub barfoo_ok ($;$) {
});
}
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
@@ -120,7 +120,7 @@ sub barfoo_ok_2 ($;$) {
barfoo_ok($value, $name);
}
{
- test_out(" # Subtest: namehere");
+ test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
@@ -138,10 +138,10 @@ sub barfoo_ok_2 ($;$) {
# A subtest-based predicate called from within a subtest
{
- test_out(" # Subtest: outergroup");
+ test_out("# Subtest: outergroup");
test_out(" 1..2");
test_out(" ok 1 - this passes");
- test_out(" # Subtest: namehere");
+ test_out(" # Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
diff --git a/cpan/Test-Simple/t/subtest/singleton.t b/cpan/Test-Simple/t/Legacy/subtest/singleton.t
index 0c25261f5b..0c25261f5b 100644
--- a/cpan/Test-Simple/t/subtest/singleton.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/singleton.t
diff --git a/cpan/Test-Simple/t/subtest/threads.t b/cpan/Test-Simple/t/Legacy/subtest/threads.t
index 0d70b1e6e5..5d053ca2db 100644
--- a/cpan/Test-Simple/t/subtest/threads.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/threads.t
@@ -5,8 +5,8 @@ use warnings;
use Config;
BEGIN {
- unless ( $] >= 5.008001 && $Config{'useithreads'} &&
- eval { require threads; 'threads'->import; 1; })
+ unless ( $] >= 5.008001 && $Config{'useithreads'} &&
+ eval { require threads; 'threads'->import; 1; })
{
print "1..0 # Skip: no working threads\n";
exit 0;
diff --git a/cpan/Test-Simple/t/subtest/todo.t b/cpan/Test-Simple/t/Legacy/subtest/todo.t
index 7269da9b95..82de40e3da 100644
--- a/cpan/Test-Simple/t/subtest/todo.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/todo.t
@@ -43,7 +43,8 @@ plan tests => 8 * @test_combos;
sub test_subtest_in_todo {
my ($name, $code, $want_out, $no_tests_run) = @_;
- my $xxx = $no_tests_run ? 'No tests run for subtest "xxx"' : 'xxx';
+ #my $xxx = $no_tests_run ? 'No tests run for subtest "xxx"' : 'xxx';
+ my @no_test_err = $no_tests_run ? ('# No tests run for subtest.') : ();
chomp $want_out;
my @outlines = split /\n/, $want_out;
@@ -52,14 +53,17 @@ sub test_subtest_in_todo {
my ($set_via, $todo_reason, $level) = @$combo;
test_out(
- " # Subtest: xxx",
+ "# Subtest: xxx",
@outlines,
- "not ok 1 - $xxx # TODO $todo_reason",
- "# Failed (TODO) test '$xxx'",
- "# at $0 line $line{xxx}.",
- "not ok 2 - regular todo test # TODO $todo_reason",
- "# Failed (TODO) test 'regular todo test'",
- "# at $0 line $line{reg}.",
+ map { my $x = $_; $x =~ s/\s+$//; $x } (
+ "not ok 1 - xxx # TODO $todo_reason",
+ "# Failed (TODO) test 'xxx'",
+ "# at $0 line $line{xxx}.",
+ @no_test_err,
+ "not ok 2 - regular todo test # TODO $todo_reason",
+ "# Failed (TODO) test 'regular todo test'",
+ "# at $0 line $line{reg}.",
+ )
);
{
@@ -77,14 +81,14 @@ sub test_subtest_in_todo {
}
}
- test_test("$name ($level), todo [$todo_reason] set via $set_via");
+ last unless test_test("$name ($level), todo [$todo_reason] set via $set_via");
}
}
package Foo; # If several stack frames are in package 'main' then $Level
# could be wrong and $main::TODO might still be found. Using
# another package makes the tests more sensitive.
-
+
sub main::subtest_at_level {
my ($name, $code, $level) = @_;
diff --git a/cpan/Test-Simple/t/subtest/wstat.t b/cpan/Test-Simple/t/Legacy/subtest/wstat.t
index ee2f19866d..ee2f19866d 100644
--- a/cpan/Test-Simple/t/subtest/wstat.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/wstat.t
diff --git a/cpan/Test-Simple/t/tbm_doesnt_set_exported_to.t b/cpan/Test-Simple/t/Legacy/tbm_doesnt_set_exported_to.t
index 8bdd17753b..4202a69926 100644
--- a/cpan/Test-Simple/t/tbm_doesnt_set_exported_to.t
+++ b/cpan/Test-Simple/t/Legacy/tbm_doesnt_set_exported_to.t
@@ -10,7 +10,7 @@ BEGIN {
use strict;
use warnings;
-# Can't use Test::More, that would set exported_to()
+# Can't use Test::More that would set exported_to()
use Test::Builder;
use Test::Builder::Module;
diff --git a/cpan/Test-Simple/t/Legacy/test_use_ok.t b/cpan/Test-Simple/t/Legacy/test_use_ok.t
new file mode 100644
index 0000000000..0b4b9a7d35
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/test_use_ok.t
@@ -0,0 +1,40 @@
+use strict;
+use Test::More;
+use ok;
+use ok 'strict';
+use ok 'Test::More';
+use ok 'ok';
+
+my $class = 'Test::Builder';
+BEGIN {
+ ok(!$class, '$class is declared, but not yet set');
+
+
+ my $success = eval 'use ok $class';
+ my $error = $@;
+
+ ok(!$success, "Threw an exception");
+ like(
+ $error,
+ qr/^'use ok' called with an empty argument, did you try to use a package name from an uninitialized variable\?/,
+ "Threw expected exception"
+ );
+
+
+
+ $success = eval 'use ok $class, "xxx"';
+ $error = $@;
+
+ ok(!$success, "Threw an exception");
+ like(
+ $error,
+ qr/^'use ok' called with an empty argument, did you try to use a package name from an uninitialized variable\?/,
+ "Threw expected exception when arguments are added"
+ );
+}
+
+my $class2;
+BEGIN {$class2 = 'Test::Builder'};
+use ok $class2;
+
+done_testing;
diff --git a/cpan/Test-Simple/t/thread_taint.t b/cpan/Test-Simple/t/Legacy/thread_taint.t
index ef7b89daef..ef7b89daef 100644
--- a/cpan/Test-Simple/t/thread_taint.t
+++ b/cpan/Test-Simple/t/Legacy/thread_taint.t
diff --git a/cpan/Test-Simple/t/Legacy/threads.t b/cpan/Test-Simple/t/Legacy/threads.t
new file mode 100644
index 0000000000..51b374d9f9
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/threads.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use Config;
+
+BEGIN {
+ if ($] == 5.010000) {
+ print "1..0 # Threads are broken on 5.10.0\n";
+ exit 0;
+ }
+
+ my $works = 1;
+ $works &&= $] >= 5.008001;
+ $works &&= $Config{'useithreads'};
+ $works &&= eval { require threads; 'threads'->import; 1 };
+
+ unless ($works) {
+ print "1..0 # Skip no working threads\n";
+ exit 0;
+ }
+
+ unless ( $ENV{AUTHOR_TESTING} ) {
+ print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
+ exit 0;
+ }
+}
+
+use strict;
+use Test::Builder;
+
+my $Test = Test::Builder->new;
+$Test->exported_to('main');
+$Test->plan(tests => 6);
+
+for(1..5) {
+ 'threads'->create(sub {
+ $Test->ok(1,"Each of these should app the test number")
+ })->join;
+}
+
+$Test->is_num($Test->current_test(), 5,"Should be five");
diff --git a/cpan/Test-Simple/t/todo.t b/cpan/Test-Simple/t/Legacy/todo.t
index 91861be3cb..9b5aa7583c 100644
--- a/cpan/Test-Simple/t/todo.t
+++ b/cpan/Test-Simple/t/Legacy/todo.t
@@ -9,6 +9,13 @@ BEGIN {
use Test::More;
+BEGIN {
+ require warnings;
+ if( eval "warnings->can('carp')" ) {
+ plan skip_all => 'Modern::Open is installed, which breaks this test';
+ }
+}
+
plan tests => 36;
@@ -74,7 +81,7 @@ TODO: {
fail("So very failed");
}
is( $warning, "todo_skip() needs to know \$how_many tests are in the ".
- "block at $0 line 74\n",
+ "block at $0 line 74.\n",
'todo_skip without $how_many warning' );
}
@@ -82,9 +89,9 @@ my $builder = Test::More->builder;
my $exported_to = $builder->exported_to;
TODO: {
$builder->exported_to("Wibble");
-
+
local $TODO = "testing \$TODO with an incorrect exported_to()";
-
+
fail("Just testing todo");
}
@@ -137,6 +144,7 @@ is $is_todo, 'Nesting TODO',
ok $in_todo, " but we're in_todo()";
}
+# line 200
eval {
$builder->todo_end;
};
diff --git a/cpan/Test-Simple/t/undef.t b/cpan/Test-Simple/t/Legacy/undef.t
index 2c8cace491..d560f8231c 100644
--- a/cpan/Test-Simple/t/undef.t
+++ b/cpan/Test-Simple/t/Legacy/undef.t
@@ -11,7 +11,14 @@ BEGIN {
}
use strict;
-use Test::More tests => 21;
+use Test::More;
+
+BEGIN {
+ require warnings;
+ if( eval "warnings->can('carp')" ) {
+ plan skip_all => 'Modern::Open is installed, which breaks this test';
+ }
+}
BEGIN { $^W = 1; }
@@ -36,7 +43,7 @@ sub warnings_like {
my $Filename = quotemeta $0;
-
+
is( undef, undef, 'undef is undef');
no_warnings;
@@ -96,3 +103,5 @@ no_warnings;
is_deeply([ undef ], [ undef ]);
no_warnings;
}
+
+done_testing;
diff --git a/cpan/Test-Simple/t/use_ok.t b/cpan/Test-Simple/t/Legacy/use_ok.t
index 9e858bc75e..9e858bc75e 100644
--- a/cpan/Test-Simple/t/use_ok.t
+++ b/cpan/Test-Simple/t/Legacy/use_ok.t
diff --git a/cpan/Test-Simple/t/useing.t b/cpan/Test-Simple/t/Legacy/useing.t
index c4ce507127..c4ce507127 100644
--- a/cpan/Test-Simple/t/useing.t
+++ b/cpan/Test-Simple/t/Legacy/useing.t
diff --git a/cpan/Test-Simple/t/utf8.t b/cpan/Test-Simple/t/Legacy/utf8.t
index f68b2a7680..2930226e3e 100644
--- a/cpan/Test-Simple/t/utf8.t
+++ b/cpan/Test-Simple/t/Legacy/utf8.t
@@ -43,9 +43,9 @@ SKIP: {
for my $method (keys %handles) {
my $src = $handles{$method};
-
+
my $dest = Test::More->builder->$method;
-
+
is_deeply { map { $_ => 1 } PerlIO::get_layers($dest) },
{ map { $_ => 1 } PerlIO::get_layers($src) },
"layers copied to $method";
@@ -56,7 +56,7 @@ SKIP: {
# Test utf8 is ok.
{
my $uni = "\x{11e}";
-
+
my @warnings;
local $SIG{__WARN__} = sub {
push @warnings, @_;
diff --git a/cpan/Test-Simple/t/Legacy/versions.t b/cpan/Test-Simple/t/Legacy/versions.t
new file mode 100644
index 0000000000..49e146ad9c
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/versions.t
@@ -0,0 +1,50 @@
+#!/usr/bin/perl -w
+
+# Make sure all the modules have the same version
+#
+# TBT has its own version system.
+
+use strict;
+use Test::More;
+
+{
+ local $SIG{__WARN__} = sub { 1 };
+ require Test::Builder::Module;
+ require Test::Builder::Tester::Color;
+ require Test::Builder::Tester;
+ require Test::Builder;
+ require Test::More;
+ require Test::Simple;
+ require Test::Stream;
+ require Test::Stream::Tester;
+ require Test::Tester;
+ require Test::use::ok;
+ require ok;
+}
+
+my $dist_version = Test::More->VERSION;
+
+like( $dist_version, qr/^ \d+ \. \d+ $/x, "Version number is sane" );
+
+my @modules = qw(
+ Test::Builder::Module
+ Test::Builder::Tester::Color
+ Test::Builder::Tester
+ Test::Builder
+ Test::More
+ Test::Simple
+ Test::Stream
+ Test::Stream::Tester
+ Test::Tester
+ Test::use::ok
+ ok
+);
+
+for my $module (@modules) {
+ my $file = $module;
+ $file =~ s{(::|')}{/}g;
+ $file .= ".pm";
+ is( $module->VERSION, $module->VERSION, sprintf("%-22s %s", $module, $INC{$file}) );
+}
+
+done_testing();
diff --git a/cpan/Test-Simple/t/Test-Builder.t b/cpan/Test-Simple/t/Test-Builder.t
new file mode 100644
index 0000000000..80d19467be
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Builder.t
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use ok 'Test::Builder';
+
+# Test::Builder is tested by the stuff in t/Legacy
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-More-DeepCheck.t b/cpan/Test-Simple/t/Test-More-DeepCheck.t
new file mode 100644
index 0000000000..9b5bbf8f5d
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-More-DeepCheck.t
@@ -0,0 +1,7 @@
+use strict;
+use warnings;
+
+use Test::More;
+use ok 'Test::More::DeepCheck';
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-More.t b/cpan/Test-Simple/t/Test-More.t
new file mode 100644
index 0000000000..76e2199b88
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-More.t
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+
+use ok 'Test::More';
+
+{
+ package Foo;
+ use Test::More import => ['!explain'];
+}
+
+{
+ package Bar;
+ BEGIN { main::use_ok('Scalar::Util', 'blessed') }
+ BEGIN { main::can_ok('Bar', qw/blessed/) }
+ blessed('x');
+}
+
+{
+ package Baz;
+ use Test::More;
+ use_ok( 'Data::Dumper' );
+ can_ok( __PACKAGE__, 'Dumper' );
+ Dumper({foo => 'bar'});
+}
+
+can_ok('Foo', qw/ok is context plan/);
+ok(!Foo->can('explain'), "explain was not imported");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-MostlyLike.t b/cpan/Test-Simple/t/Test-MostlyLike.t
new file mode 100644
index 0000000000..b73a410caf
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-MostlyLike.t
@@ -0,0 +1,159 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::MostlyLike;
+use Test::More;
+use Test::Stream::Tester;
+
+use ok 'Test::MostlyLike';
+
+{
+ package XXX;
+
+ sub new { bless {ref => ['a']}, shift };
+
+ sub numbers { 1 .. 10 };
+ sub letters { 'a' .. 'e' };
+ sub ref { [ 1 .. 10 ] };
+}
+
+events_are (
+ intercept {
+ mostly_like( 'a', 'a', "match" );
+ mostly_like( 'a', 'b', "no match" );
+
+ mostly_like(
+ [ qw/a b c/ ],
+ [ qw/a b c/ ],
+ "all match",
+ );
+
+ mostly_like(
+ [qw/a b c/],
+ { 1 => 'b' },
+ "Only check one index (match)",
+ );
+ mostly_like(
+ [qw/a b c/],
+ { 1 => 'x' },
+ "Only check one index (no match)",
+ );
+
+ mostly_like(
+ { a => 1, b => 2, c => 3 },
+ { a => 1, b => 2, c => 3 },
+ "all match"
+ );
+
+ mostly_like(
+ { a => 1, b => 2, c => 3 },
+ { b => 2, d => undef },
+ "A match and an expected empty"
+ );
+
+ mostly_like(
+ { a => 1, b => 2, c => 3 },
+ { b => undef },
+ "Expect empty (fail)"
+ );
+
+ mostly_like(
+ { a => 'foo', b => 'bar' },
+ { a => qr/o/, b => qr/a/ },
+ "Regex check"
+ );
+
+ mostly_like(
+ { a => 'foo', b => 'bar' },
+ { a => qr/o/, b => qr/o/ },
+ "Regex check fail"
+ );
+
+ mostly_like(
+ { a => { b => { c => { d => 1 }}}},
+ { a => { b => { c => { d => 1 }}}},
+ "Deep match"
+ );
+
+ mostly_like(
+ { a => { b => { c => { d => 1 }}}},
+ { a => { b => { c => { d => 2 }}}},
+ "Deep mismatch"
+ );
+
+ mostly_like(
+ XXX->new,
+ {
+ ':ref' => ['a'],
+ ref => [ 1 .. 10 ],
+ '[numbers]' => [ 1 .. 10 ],
+ '[letters]' => [ 'a' .. 'e' ],
+ },
+ "Object check"
+ );
+
+ mostly_like(
+ XXX->new,
+ {
+ ':ref' => ['a'],
+ ref => [ 1 .. 10 ],
+ '[numbers]' => [ 1 .. 10 ],
+ '[letters]' => [ 'a' .. 'e' ],
+ '[invalid]' => [ 'x' ],
+ },
+ "Object check"
+ );
+
+ },
+ check {
+ event ok => { bool => 1 };
+ event ok => {
+ bool => 0,
+ diag => qr/got: 'a'.*\n.*expected: 'b'/,
+ };
+
+ event ok => { bool => 1 };
+ event ok => { bool => 1 };
+
+ event ok => {
+ bool => 0,
+ diag => qr/\$got->\[1\] = 'b'\n\s*\$expected->\[1\] = 'x'/,
+ };
+
+ event ok => { bool => 1 };
+ event ok => { bool => 1 };
+
+ event ok => {
+ bool => 0,
+ diag => qr/\$got->\{b\} = '2'\n\s*\$expected->\{b\} = undef/,
+ };
+
+ event ok => { bool => 1 };
+ event ok => {
+ bool => 0,
+ diag => qr/\$got->\{b\} = 'bar'\n\s+\$expected->\{b\} = .*o/,
+ };
+
+ event ok => { bool => 1 };
+ event ok => {
+ bool => 0,
+ diag => qr/\$got->\Q{a}{b}{c}{d}\E = '1'\n\s+\$expected->\Q{a}{b}{c}{d}\E = '2'/,
+ };
+
+ event ok => { bool => 1 };
+ event ok => {
+ bool => 0,
+ diag => [
+ qr/\[\s+\$got->invalid\(\)\] = '\(EXCEPTION\)'/,
+ qr/\[\$expected->\{invalid\}\] = ARRAY/,
+ qr/Can't locate object method "invalid" via package "XXX"/,
+ ],
+ };
+
+ directive 'end';
+ },
+ "Tolerant"
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Simple.t b/cpan/Test-Simple/t/Test-Simple.t
new file mode 100644
index 0000000000..8e1fe7ddb1
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Simple.t
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::Simple tests => 1;
+use Test::Stream::Tester;
+
+events_are (
+ intercept {
+ ok(1, "Pass");
+ ok(0, "Fail");
+ },
+ check {
+ event ok => {
+ bool => 1,
+ name => 'Pass',
+ diag => '',
+ };
+ event ok => {
+ bool => 0,
+ name => 'Fail',
+ diag => qr/Failed test 'Fail'/,
+ };
+ },
+);
diff --git a/cpan/Test-Simple/t/Test-Stream-ArrayBase-Meta.t b/cpan/Test-Simple/t/Test-Stream-ArrayBase-Meta.t
new file mode 100644
index 0000000000..7658dbbe1d
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-ArrayBase-Meta.t
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use ok 'Test::Stream::ArrayBase::Meta';
+
+# This class is tested in the Test::Stream::ArrayBase tests
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-ArrayBase.t b/cpan/Test-Simple/t/Test-Stream-ArrayBase.t
new file mode 100644
index 0000000000..f81f29f4cc
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-ArrayBase.t
@@ -0,0 +1,97 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib 'lib';
+
+BEGIN {
+ $INC{'My/ABase.pm'} = __FILE__;
+
+ package My::ABase;
+ use Test::Stream::ArrayBase(
+ accessors => [qw/foo bar baz/],
+ );
+
+ use Test::More;
+ is(FOO, 0, "FOO CONSTANT");
+ is(BAR, 1, "BAR CONSTANT");
+ is(BAZ, 2, "BAZ CONSTANT");
+
+ my $bad = eval { Test::Stream::ArrayBase->import( accessors => [qw/foo/] ); 1 };
+ my $error = $@;
+ ok(!$bad, "Threw exception");
+ like($error, qr/field 'foo' already defined/, "Expected error");
+}
+
+BEGIN {
+ package My::ABaseSub;
+ use Test::Stream::ArrayBase(
+ accessors => [qw/apple pear/],
+ base => 'My::ABase',
+ );
+
+ use Test::More;
+ is(FOO, 0, "FOO CONSTANT");
+ is(BAR, 1, "BAR CONSTANT");
+ is(BAZ, 2, "BAZ CONSTANT");
+ is(APPLE, 3, "APPLE CONSTANT");
+ is(PEAR, 4, "PEAR CONSTANT");
+
+ my $bad = eval { Test::Stream::ArrayBase->import( base => 'foobarbaz' ); 1 };
+ my $error = $@;
+ ok(!$bad, "Threw exception");
+ like($error, qr/My::ABaseSub is already a subclass of 'My::ABase'/, "Expected error");
+}
+
+{
+ package My::ABase;
+ my $bad = eval { Test::Stream::ArrayBase->import( accessors => [qw/xerxes/] ); 1 };
+ my $error = $@;
+ ok(!$bad, "Threw exception");
+ like($error, qr/Cannot add accessor, metadata is locked due to a subclass being initialized/, "Expected error");
+}
+
+{
+ package Consumer;
+ use My::ABase qw/BAR/;
+ use Test::More;
+
+ is(BAR, 1, "Can import contants");
+
+ my $bad = eval { Test::Stream::ArrayBase->import( base => 'Test::More' ); 1 };
+ my $error = $@;
+ ok(!$bad, "Threw exception");
+ like($error, qr/Base class 'Test::More' is not a subclass of Test::Stream::ArrayBase/, "Expected error");
+}
+
+isa_ok('My::ABase', 'Test::Stream::ArrayBase');
+isa_ok('My::ABaseSub', 'Test::Stream::ArrayBase');
+isa_ok('My::ABaseSub', 'My::ABase');
+
+my $one = My::ABase->new(qw/a b c/);
+is($one->foo, 'a', "Accessor");
+is($one->bar, 'b', "Accessor");
+is($one->baz, 'c', "Accessor");
+$one->set_foo('x');
+is($one->foo, 'x', "Accessor set");
+$one->set_foo(undef);
+
+is_deeply(
+ $one->to_hash,
+ {
+ foo => undef,
+ bar => 'b',
+ baz => 'c',
+ },
+ 'to_hash'
+);
+
+my $two = My::ABase->new_from_pairs(
+ foo => 'foo',
+ bar => 'bar',
+);
+
+is($two->foo, 'foo', "set by pair");
+is($two->bar, 'bar', "set by pair");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Carp.t b/cpan/Test-Simple/t/Test-Stream-Carp.t
new file mode 100644
index 0000000000..e599cb428a
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Carp.t
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+
+# On some threaded systems this test cannot be run.
+BEGIN {
+ require Test::Stream::Threads;
+ if ($INC{'Carp.pm'}) {
+ print "1..0 # Carp is already loaded before we even begin.\n";
+ exit 0;
+ }
+}
+
+my @stack;
+BEGIN {
+ unshift @INC => sub {
+ my ($ref, $filename) = @_;
+ return if @stack;
+ return unless $filename eq 'Carp.pm';
+ my %seen;
+ my $level = 1;
+ while (my @call = caller($level++)) {
+ my ($pkg, $file, $line) = @call;
+ next if $seen{"$file $line"}++;
+ push @stack => \@call;
+ }
+ return;
+ };
+}
+
+use Test::More;
+
+BEGIN {
+ my $r = ok(!$INC{'Carp.pm'}, "Carp is not loaded when we start");
+}
+
+use ok 'Test::Stream::Carp', 'croak';
+
+ok(!$INC{'Carp.pm'}, "Carp is not loaded");
+
+if (@stack) {
+ my $msg = "Carp load trace:\n";
+ $msg .= " $_->[1] line $_->[2]\n" for @stack;
+ diag $msg;
+}
+
+my $out = eval { croak "xxx"; 1 };
+my $err = $@;
+ok(!$out, "died");
+like($err, qr/xxx/, "Got carp exception");
+
+ok($INC{'Carp.pm'}, "Carp is loaded now");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Event-Diag.t b/cpan/Test-Simple/t/Test-Stream-Event-Diag.t
new file mode 100644
index 0000000000..95ba48ea6e
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Event-Diag.t
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'Test::Stream::Event::Diag';
+
+my $ctx = context(-1); my $line = __LINE__;
+$ctx = $ctx->snapshot;
+is($ctx->line, $line, "usable context");
+
+my $diag = $ctx->diag('hello');
+ok($diag, "build diag");
+isa_ok($diag, 'Test::Stream::Event::Diag');
+is($diag->message, 'hello', "message");
+
+is_deeply(
+ [$diag->to_tap],
+ [[Test::Stream::Event::Diag::OUT_ERR, "# hello\n"]],
+ "Got tap"
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Event-Finish.t b/cpan/Test-Simple/t/Test-Stream-Event-Finish.t
new file mode 100644
index 0000000000..db396bbbf3
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Event-Finish.t
@@ -0,0 +1,7 @@
+use strict;
+use warnings;
+use Test::More;
+
+use ok 'Test::Stream::Event::Finish';
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Event-Note.t b/cpan/Test-Simple/t/Test-Stream-Event-Note.t
new file mode 100644
index 0000000000..b3bd2efda2
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Event-Note.t
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'Test::Stream::Event::Note';
+
+my $note = Test::Stream::Event::Note->new('fake', 'fake', 0, "hello");
+
+is($note->message, 'hello', "got message");
+
+is_deeply(
+ [$note->to_tap],
+ [[Test::Stream::Event::Note::OUT_STD, "# hello\n"]],
+ "Got handle id and message in tap",
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Event.t b/cpan/Test-Simple/t/Test-Stream-Event.t
new file mode 100644
index 0000000000..1351059e45
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Event.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'Test::Stream::Event';
+
+can_ok('Test::Stream::Event', qw/context created in_subtest/);
+
+my $ok = eval { Test::Stream::Event->new(); 1 };
+my $err = $@;
+ok(!$ok, "Died");
+like($err, qr/No context provided/, "Need context");
+
+{
+ package My::MockEvent;
+ use Test::Stream::Event(
+ accessors => [qw/foo bar baz/],
+ );
+}
+
+can_ok('My::MockEvent', qw/foo bar baz/);
+isa_ok('My::MockEvent', 'Test::Stream::Event');
+
+my $one = My::MockEvent->new('fake');
+
+can_ok('Test::Stream::Context', 'mockevent');
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-ExitMagic-Context.t b/cpan/Test-Simple/t/Test-Stream-ExitMagic-Context.t
new file mode 100644
index 0000000000..42e002056c
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-ExitMagic-Context.t
@@ -0,0 +1,8 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use ok 'Test::Stream::ExitMagic::Context';
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Exporter-Meta.t b/cpan/Test-Simple/t/Test-Stream-Exporter-Meta.t
new file mode 100644
index 0000000000..124fedd8f2
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Exporter-Meta.t
@@ -0,0 +1,9 @@
+use strict;
+use warnings;
+use Test::More;
+
+use ok 'Test::Stream::Exporter::Meta';
+
+# This is tested by the Test::Stream::Exporter tests.
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Exporter.t b/cpan/Test-Simple/t/Test-Stream-Exporter.t
new file mode 100644
index 0000000000..e633850402
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Exporter.t
@@ -0,0 +1,87 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+ package My::Exporter;
+ use Test::Stream::Exporter;
+ use Test::More;
+
+ export a => sub { 'a' };
+ default_export b => sub { 'b' };
+
+ export 'c';
+ sub c { 'c' }
+
+ default_export x => sub { 'x' };
+
+ our $export = "here";
+ $main::export::xxx = 'here';
+
+ export '$export' => \$export;
+
+ Test::Stream::Exporter->cleanup;
+
+ is($export, 'here', "still have an \$export var");
+ is($main::export::xxx, 'here', "still have an \$export::* var");
+
+ ok(!__PACKAGE__->can($_), "removed $_\()") for qw/export default_export exports default_exports/;
+
+ my $ok = eval {
+ export no => sub { 'no' };
+ 1;
+ };
+ my $error = $@;
+ ok(!$ok, "Cannot add exports after cleanup");
+ like($error, qr/Undefined subroutine &My::Exporter::export called/, "Sub was removed");
+}
+
+My::Exporter->import( '!x' );
+
+can_ok(__PACKAGE__, qw/b/);
+ok(!__PACKAGE__->can($_), "did not import $_\()") for qw/a c x/;
+
+My::Exporter->import(qw/a c/);
+can_ok(__PACKAGE__, qw/a b c/);
+
+ok(!__PACKAGE__->can($_), "did not import $_\()") for qw/x/;
+
+My::Exporter->import();
+can_ok(__PACKAGE__, qw/a b c x/);
+
+is(__PACKAGE__->$_(), $_, "$_() eq '$_', Function is as expected") for qw/a b c x/;
+
+ok(! defined $::export, "no export scalar");
+My::Exporter->import('$export');
+is($::export, 'here', "imported export scalar");
+
+use Test::Stream::Exporter qw/export_meta/;
+my $meta = export_meta('My::Exporter');
+isa_ok($meta, 'Test::Stream::Exporter::Meta');
+is_deeply(
+ [sort $meta->default],
+ [sort qw/b x/],
+ "Got default list"
+);
+
+is_deeply(
+ [sort $meta->all],
+ [sort qw/a b c x $export/],
+ "Got all list"
+);
+
+is_deeply(
+ $meta->exports,
+ {
+ a => __PACKAGE__->can('a') || undef,
+ b => __PACKAGE__->can('b') || undef,
+ c => __PACKAGE__->can('c') || undef,
+ x => __PACKAGE__->can('x') || undef,
+
+ '$export' => \$My::Exporter::export,
+ },
+ "Exports are what we expect"
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-IOSets.t b/cpan/Test-Simple/t/Test-Stream-IOSets.t
new file mode 100644
index 0000000000..c2da17eca3
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-IOSets.t
@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::MostlyLike;
+use Test::More;
+
+use ok 'Test::Stream::IOSets';
+
+my ($out, $err) = Test::Stream::IOSets->open_handles;
+ok($out && $err, "got 2 handles");
+ok(close($out), "Close stdout");
+ok(close($err), "Close stderr");
+
+my $one = Test::Stream::IOSets->new;
+isa_ok($one, 'Test::Stream::IOSets');
+mostly_like(
+ $one,
+ { ':legacy' => [], ':utf8' => undef },
+ "Legacy encoding is set",
+);
+
+ok($one->init_encoding('utf8'), "init utf8");
+
+mostly_like(
+ $one,
+ { ':legacy' => [], ':utf8' => [] },
+ "utf8 encoding is set",
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Meta.t b/cpan/Test-Simple/t/Test-Stream-Meta.t
new file mode 100644
index 0000000000..8417b13aff
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Meta.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'Test::Stream::Meta';
+
+my $meta = init_tester('Some::Package');
+ok($meta, "got meta");
+isa_ok($meta, 'Test::Stream::Meta');
+can_ok($meta, qw/package encoding modern todo stream/);
+
+is(is_tester('Some::Package'), $meta, "remember the meta");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-PackageUtil.t b/cpan/Test-Simple/t/Test-Stream-PackageUtil.t
new file mode 100644
index 0000000000..e55c0f9a4b
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-PackageUtil.t
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'Test::Stream::PackageUtil';
+
+can_ok(__PACKAGE__, qw/package_sym package_purge_sym/);
+
+my $ok = package_sym(__PACKAGE__, CODE => 'ok');
+is($ok, \&ok, "package sym gave us the code symbol");
+
+my $todo = package_sym(__PACKAGE__, SCALAR => 'TODO');
+is($todo, \$TODO, "got the TODO scalar");
+
+our $foo = 'foo';
+our @foo = ('f', 'o', 'o');
+our %foo = (f => 'oo');
+sub foo { 'foo' };
+
+is(foo(), 'foo', "foo() is defined");
+is($foo, 'foo', '$foo is defined');
+is_deeply(\@foo, [ 'f', 'o', 'o' ], '@foo is defined');
+is_deeply(\%foo, { f => 'oo' }, '%foo is defined');
+
+package_purge_sym(__PACKAGE__, CODE => 'foo');
+
+is($foo, 'foo', '$foo is still defined');
+is_deeply(\@foo, [ 'f', 'o', 'o' ], '@foo is still defined');
+is_deeply(\%foo, { f => 'oo' }, '%foo is still defined');
+my $r = eval { foo() };
+my $e = $@;
+ok(!$r, "Failed to call foo()");
+like($e, qr/Undefined subroutine &main::foo called/, "foo() is not defined anymore");
+ok(!__PACKAGE__->can('foo'), "can() no longer thinks we can do foo()");
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Tester-Grab.t b/cpan/Test-Simple/t/Test-Stream-Tester-Grab.t
new file mode 100644
index 0000000000..505980790a
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Tester-Grab.t
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use ok 'Test::Stream::Tester::Grab';
+
+# The tests for this can be found in t/Test-Tester2.t which is the only context
+# that makes sense.
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Tester.t b/cpan/Test-Simple/t/Test-Stream-Tester.t
new file mode 100644
index 0000000000..7eac4005a5
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Tester.t
@@ -0,0 +1,140 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'Test::Stream::Tester';
+
+can_ok( __PACKAGE__, 'intercept', 'events_are' );
+
+my $events = intercept {
+ ok(1, "Woo!");
+ ok(0, "Boo!");
+};
+
+isa_ok($events->[0], 'Test::Stream::Event::Ok');
+is($events->[0]->bool, 1, "Got one success");
+is($events->[0]->name, "Woo!", "Got test name");
+
+isa_ok($events->[1], 'Test::Stream::Event::Ok');
+is($events->[1]->bool, 0, "Got one fail");
+is($events->[1]->name, "Boo!", "Got test name");
+
+$events = undef;
+my $grab = grab();
+my $got = $grab ? 1 : 0;
+ok(1, "Intercepted!");
+ok(0, "Also Intercepted!");
+$events = $grab->finish;
+ok($got, "Delayed test that we did in fact get a grab object");
+is($grab, undef, "Poof! vanished!");
+is(@$events, 2, "got 2 events (2 ok)");
+events_are(
+ $events,
+ check {
+ event ok => { bool => 1 };
+ event ok => {
+ bool => 0,
+ diag => qr/Failed/,
+ };
+ dir 'end';
+ },
+ 'intercepted via grab 1'
+);
+
+$events = undef;
+$grab = grab();
+ok(1, "Intercepted!");
+ok(0, "Also Intercepted!");
+events_are(
+ $grab,
+ check {
+ event ok => { bool => 1 };
+ event ok => { bool => 0, diag => qr/Failed/ };
+ dir 'end';
+ },
+ 'intercepted via grab 2'
+);
+ok(!$grab, "Maybe it never existed?");
+
+$events = intercept {
+ ok(1, "Woo!");
+ BAIL_OUT("Ooops");
+ ok(0, "Should not see this");
+};
+is(@$events, 2, "Only got 2");
+isa_ok($events->[0], 'Test::Stream::Event::Ok');
+isa_ok($events->[1], 'Test::Stream::Event::Bail');
+
+$events = intercept {
+ plan skip_all => 'All tests are skipped';
+
+ ok(1, "Woo!");
+ BAIL_OUT("Ooops");
+ ok(0, "Should not see this");
+};
+is(@$events, 1, "Only got 1");
+isa_ok($events->[0], 'Test::Stream::Event::Plan');
+
+my $file = __FILE__;
+my $line1;
+my $line2;
+events_are(
+ intercept {
+ events_are(
+ intercept { ok(1, "foo"); $line1 = __LINE__ },
+ check {
+ $line2 = __LINE__ + 1;
+ event ok => {bool => 0};
+ dir 'end';
+ },
+ 'Lets name this test!',
+ );
+ },
+
+ check {
+ event ok => {
+ bool => 0,
+ diag => [
+ qr{Failed test 'Lets name this test!'.*at (\./)?$0 line}s,
+ qr{ Event: 'ok' from \Q$0\E line $line1}s,
+ qr{ Check: 'ok' from \Q$0\E line $line2}s,
+ qr{ \$got->\{bool\} = '1'},
+ qr{ \$exp->\{bool\} = '0'},
+ ],
+ };
+
+ dir 'end';
+ },
+ 'Failure diag checking',
+);
+
+my $line3;
+events_are(
+ intercept {
+ events_are(
+ intercept { ok(1, "foo"); ok(1, "bar"); $line3 = __LINE__ },
+ check {
+ event ok => {bool => 1};
+ dir 'end'
+ },
+ "Should Fail"
+ );
+ },
+
+ check {
+ event ok => {
+ bool => 0,
+ diag => [
+ qr/Failed test 'Should Fail'/,
+ qr/Expected end of events, got 'ok' from \Q$0\E line $line3/,
+ ],
+ };
+ },
+
+ end => 'skipping a diag',
+);
+
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Toolset.t b/cpan/Test-Simple/t/Test-Stream-Toolset.t
new file mode 100644
index 0000000000..432af90984
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Toolset.t
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'Test::Stream::Toolset';
+
+can_ok(__PACKAGE__, qw/is_tester init_tester context/);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Stream-Util.t b/cpan/Test-Simple/t/Test-Stream-Util.t
new file mode 100644
index 0000000000..fa9ff54aec
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-Util.t
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+use Scalar::Util qw/dualvar/;
+
+use ok 'Test::Stream::Util', qw{
+ try protect spoof is_regex is_dualvar
+};
+
+can_ok(__PACKAGE__, qw{
+ try protect spoof is_regex is_dualvar
+});
+
+my $x = dualvar( 100, 'one-hundred' );
+ok(is_dualvar($x), "Got dual var");
+$x = 1;
+ok(!is_dualvar($x), "Not dual var");
+
+$! = 100;
+
+my $ok = eval { protect { die "xxx" }; 1 };
+ok(!$ok, "protect did not capture exception");
+like($@, qr/xxx/, "expected exception");
+
+cmp_ok($!, '==', 100, "\$! did not change");
+$@ = 'foo';
+
+($ok, my $err) = try { die "xxx" };
+ok(!$ok, "cought exception");
+like( $err, qr/xxx/, "expected exception");
+is($@, 'foo', '$@ is saved');
+cmp_ok($!, '==', 100, "\$! did not change");
+
+ok(is_regex(qr/foo bar baz/), 'qr regex');
+ok(is_regex('/xxx/'), 'slash regex');
+ok(!is_regex('xxx'), 'not a regex');
+
+my ($ret, $e) = spoof ["The::Moon", "Moon.pm", 11] => "die 'xxx' . __PACKAGE__";
+ok(!$ret, "Failed eval");
+like( $e, qr/^xxxThe::Moon at Moon\.pm line 11\.?/, "Used correct package, file, and line");
+
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Tester-Capture.t b/cpan/Test-Simple/t/Test-Tester-Capture.t
new file mode 100644
index 0000000000..c4a61bae37
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Tester-Capture.t
@@ -0,0 +1,9 @@
+use strict;
+use warnings;
+
+use Test::More;
+use ok 'Test::Tester::Capture';
+
+# This is tested in t/Legacy/TestTester
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-Tester.t b/cpan/Test-Simple/t/Test-Tester.t
new file mode 100644
index 0000000000..260b228531
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Tester.t
@@ -0,0 +1,9 @@
+use strict;
+use warnings;
+
+use Test::More;
+use ok 'Test::Tester';
+
+# The tests for this can be found in t/Legacy/TestTester
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test-use-ok.t b/cpan/Test-Simple/t/Test-use-ok.t
new file mode 100644
index 0000000000..b84b4a15fd
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-use-ok.t
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use Test::Stream;
+use Test::More;
+
+use ok 'ok';
+
+use Test::Stream::Tester;
+
+events_are (
+ intercept {
+ eval "use ok 'Something::Fake'; 1" || die $@;
+ },
+ check {
+ event ok => {
+ bool => 0,
+ name => 'use Something::Fake;',
+ diag => qr/^\s*Failed test 'use Something::Fake;'/,
+ };
+ },
+ "Basic test"
+);
+
+done_testing;
diff --git a/cpan/Test-Simple/t/lib/MyTest.pm b/cpan/Test-Simple/t/lib/MyTest.pm
new file mode 100644
index 0000000000..e8ad8a3e53
--- /dev/null
+++ b/cpan/Test-Simple/t/lib/MyTest.pm
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+
+package MyTest;
+
+use Test::Builder;
+
+my $Test = Test::Builder->new;
+
+sub ok
+{
+ $Test->ok(@_);
+}
+
+1;
diff --git a/cpan/Test-Simple/t/lib/SmallTest.pm b/cpan/Test-Simple/t/lib/SmallTest.pm
new file mode 100644
index 0000000000..c2a875855e
--- /dev/null
+++ b/cpan/Test-Simple/t/lib/SmallTest.pm
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+
+package SmallTest;
+
+require Exporter;
+
+use vars qw( @ISA @EXPORT );
+@ISA = qw( Exporter );
+@EXPORT = qw( ok is_eq is_num );
+
+use Test::Builder;
+
+my $Test = Test::Builder->new;
+
+sub ok
+{
+ $Test->ok(@_);
+}
+
+sub is_eq
+{
+ $Test->is_eq(@_);
+}
+
+sub is_num
+{
+ $Test->is_num(@_);
+}
+
+sub getTest
+{
+ return $Test;
+}
+1;
diff --git a/cpan/Test-Simple/t/threads.t b/cpan/Test-Simple/t/threads.t
deleted file mode 100644
index 42ba8c269c..0000000000
--- a/cpan/Test-Simple/t/threads.t
+++ /dev/null
@@ -1,33 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = '../lib';
- }
-}
-
-use Config;
-BEGIN {
- unless ( $] >= 5.008001 && $Config{'useithreads'} &&
- eval { require threads; 'threads'->import; 1; })
- {
- print "1..0 # Skip: no working threads\n";
- exit 0;
- }
-}
-
-use strict;
-use Test::Builder;
-
-my $Test = Test::Builder->new;
-$Test->exported_to('main');
-$Test->plan(tests => 6);
-
-for(1..5) {
- 'threads'->create(sub {
- $Test->ok(1,"Each of these should app the test number")
- })->join;
-}
-
-$Test->is_num($Test->current_test(), 5,"Should be five");
diff --git a/cpan/Test-Simple/t/versions.t b/cpan/Test-Simple/t/versions.t
deleted file mode 100644
index cb83599364..0000000000
--- a/cpan/Test-Simple/t/versions.t
+++ /dev/null
@@ -1,28 +0,0 @@
-#!/usr/bin/perl -w
-
-# Make sure all the modules have the same version
-#
-# TBT has its own version system.
-
-use strict;
-use Test::More;
-
-require Test::Builder;
-require Test::Builder::Module;
-require Test::Simple;
-
-my $dist_version = Test::More->VERSION;
-
-like( $dist_version, qr/^ \d+ \. \d+ $/x );
-
-my @modules = qw(
- Test::Simple
- Test::Builder
- Test::Builder::Module
-);
-
-for my $module (@modules) {
- is( $dist_version, $module->VERSION, $module );
-}
-
-done_testing(4);
diff --git a/cpan/Test-Simple/t/xt/dependents.t b/cpan/Test-Simple/t/xt/dependents.t
new file mode 100644
index 0000000000..04b9a766b8
--- /dev/null
+++ b/cpan/Test-Simple/t/xt/dependents.t
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+# Test important dependant modules so we don't accidentally half of CPAN.
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ plan skip_all => "Dependents only tested when releasing" unless $ENV{PERL_RELEASING};
+}
+
+require File::Spec;
+use CPAN;
+
+CPAN::HandleConfig->load;
+$CPAN::Config->{test_report} = 0;
+
+# Module which depend on Test::More to test
+my @Modules = qw(
+ Test::Tester
+ Test::Most
+ Test::Warn
+ Test::Exception
+ Test::Class
+ Test::Deep
+ Test::Differences
+ Test::NoWarnings
+);
+
+# Modules which are known to be broken
+my %Broken = map { $_ => 1 } (
+ 'Test::Most',
+ 'Test::Differences'
+);
+
+# Have to do it here because CPAN chdirs.
+my $perl5lib = join ":", File::Spec->rel2abs("blib/lib"), File::Spec->rel2abs("lib");
+
+TODO: for my $name (@ARGV ? @ARGV : @Modules) {
+ local $TODO = "$name known to be broken" if $Broken{$name};
+ local $ENV{PERL5LIB} = $perl5lib;
+
+ my $module = CPAN::Shell->expand("Module", $name);
+ $module->make;
+ $module->test;
+ my $test_result = $module->distribution->{make_test};
+ ok( $test_result && !$test_result->failed, $name );
+}
+done_testing();