Revert "Update Test-Simple to CPAN version 1.001009"

This reverts commit 3709f1d4bd0179938a418d9337449fdf20a783bc.

We are using the alphas in blead currently, not stable, this update
squashed that.

1 files changed, 725 insertions, 0 deletions

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..80e45bd0d5
--- /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/;
+
+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