Test2-Suite

 view release on metacpan or  search on metacpan

lib/Test2/Tools/Compare.pm  view on Meta::CPAN

    }
    else {
        $ctx->ok(0, $name, ["Comparison matched (it should not).", @diag]);
        $ctx->$_autodump($got);
    }

    $ctx->release;
    return $delta ? 1 : 0;
}

sub meta(&)       { build('Test2::Compare::Meta',          @_) }
sub meta_check(&) { build('Test2::Compare::Meta',          @_) }
sub hash(&)       { build('Test2::Compare::Hash',          @_) }
sub array(&)      { build('Test2::Compare::Array',         @_) }
sub bag(&)        { build('Test2::Compare::Bag',           @_) }
sub object(&)     { build('Test2::Compare::Object',        @_) }
sub subset(&)     { build('Test2::Compare::OrderedSubset', @_) }

sub U() {
    my @caller = caller;
    Test2::Compare::Custom->new(
        code => sub { defined $_ ? 0 : 1 }, name => 'UNDEFINED', operator => '!DEFINED()',
        file => $caller[1],
        lines => [$caller[2]],
    );
}

lib/Test2/Tools/Compare.pm  view on Meta::CPAN

    my ($class_name, @args) = @_;
    my @caller = caller;
    return Test2::Compare::Isa->new(
        file  => $caller[1],
        lines => [$caller[2]],
        input => $class_name,
        @args,
    );
}

sub filter_items(&) {
    defined( my $build = get_build() ) or croak "No current build!";

    croak "'$build' does not support filters"
        unless $build->can('add_filter');

    croak "'filter_items' should only ever be called in void context"
        if defined wantarray;

    $build->add_filter(@_);
}

lib/Test2/Tools/Exception.pm  view on Meta::CPAN

use warnings;

our $VERSION = '0.000163';

use Carp qw/carp/;
use Test2::API qw/context/;

our @EXPORT = qw/dies lives try_ok/;
use base 'Exporter';

sub dies(&) {
    my $code = shift;

    defined wantarray or carp "Useless use of dies() in void context";

    local ($@, $!, $?);
    my $ok = eval { $code->(); 1 };
    my $err = $@;

    return undef if $ok;

    unless ($err) {
        my $ctx = context();
        $ctx->alert("Got exception as expected, but exception is falsy (undef, '', or 0)...");
        $ctx->release;
    }

    return $err;
}

sub lives(&) {
    my $code = shift;

    defined wantarray or carp "Useless use of lives() in void context";

    my $err;
    {
        local ($@, $!, $?);
        eval { $code->(); 1 } and return 1;
        $err = $@;
    }

    # If the eval failed we want to set $@ to the error.
    $@ = $err;
    return 0;
}

sub try_ok(&;$) {
    my ($code, $name) = @_;

    my $ok = &lives($code);
    my $err = $@;

    # Context should be obtained AFTER code is run so that events inside the
    # codeblock report inside the codeblock itself. This will also preserve $@
    # as thrown inside the codeblock.
    my $ctx = context();
    chomp(my $diag = "Exception: $err");

lib/Test2/Tools/Warnings.pm  view on Meta::CPAN

use strict;
use warnings;

our $VERSION = '0.000163';

use Test2::API qw/context/;

our @EXPORT = qw/warns warning warnings no_warnings/;
use base 'Exporter';

sub warns(&) {
    my $code = shift;
    my $warnings = 0;
    local $SIG{__WARN__} = sub { $warnings++ };
    $code->();
    return $warnings;
}

sub no_warnings(&) { return !&warns(@_) }

sub warning(&) {
    my $code = shift;
    my @warnings;
    {
        local $SIG{__WARN__} = sub { push @warnings => @_ };
        $code->();
        return unless @warnings;
    }

    if (@warnings > 1) {
        my $ctx = context();
        $ctx->alert("Extra warnings in warning { ... }");
        $ctx->note($_) for @warnings;
        $ctx->release;
    }

    return $warnings[0];
}

sub warnings(&) {
    my $code = shift;

    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings => @_ };
    $code->();

    return \@warnings;
}

1;

t/modules/Plugin/SRand.t  view on Meta::CPAN

use Test2::Tools::Basic;
use Test2::API qw/intercept test2_stack context/;
use Test2::Tools::Compare qw/array event end is like/;
use Test2::Tools::Target 'Test2::Plugin::SRand';
use Test2::Tools::Warnings qw/warning/;

test2_stack->top;
my ($root) = test2_stack->all;

sub intercept_2(&) {
    my $code = shift;

    # This is to force loading to happen
    my $ctx = context();

    my @events;

    my $l = $root->listen(sub {
        my ($h, $e) = @_;
        push @events => $e;

t/modules/Tools/Defer.t  view on Meta::CPAN

    def is => (1, 1, "1 is 1");
    def is => ({}, {}, "hash is hash");

    def ok => (0, 'lies');
    def is => (0, 1, "1 is not 0");
    def is => ({}, [], "a hash is not an array");
}

use Test2::Bundle::Extended -target => 'Test2::Tools::Defer';

sub capture(&) {
    my $code = shift;

    my ($err, $out) = ("", "");

    my ($ok, $e);
    {
        local *STDOUT;
        local *STDERR;

        ($ok, $e) = Test2::Util::try(sub {