Assert-Refute

 view release on metacpan or  search on metacpan

lib/Assert/Refute/Build.pm  view on Meta::CPAN

message. (Think C<ok 1>, C<ok 1 'test passed'>).

=head1 FUNCTIONS

All functions are exportable.

=cut

use Carp;
use Data::Dumper;
use Scalar::Util qw(weaken blessed set_prototype looks_like_number refaddr);
use parent qw(Exporter);
our @EXPORT = qw(build_refute current_contract to_scalar);

# NOTE HACK
# If we're being loaded after Test::More, we're *likely* inside a test script
# This has to be re-done properly
# Cannot instantiate *here* because cyclic dependencies
#    so wait until current_contract() is called
our $MORE_DETECTED = Test::Builder->can("new") ? 1 : 0;

lib/Assert/Refute/Report.pm  view on Meta::CPAN

=cut

# Now this module is the CORE of Assert::Refute.
# There are 3 things for which performance matters:
# 1) new()
# 2) refute( 0, ... )
# 3) done_testing()
# The rest can wait.

use Carp;
use Scalar::Util qw( blessed weaken );

use Assert::Refute::Build qw(to_scalar);

# Always add basic testing primitives to the arsenal
require Assert::Refute::T::Basic;

my $ERROR_DONE = "done_testing was called, no more changes may be added";

=head1 METHODS

lib/Assert/Refute/Report.pm  view on Meta::CPAN

    return [ 0, 0, $line ];
};

=head2 set_parent

    $report->set_parent($bigger_report);
    $report->set_parent(undef);

Indicate that a contract is part of a larger one.
The parent object should be an L<Assert::Refute::Report> instance.
The parent object reference will be weakened to avoid memory leak.

Provide C<undef> as argument to erase parent information.

Returns self, so that calls to set_parent can be chained.

This is used internally by L</subcontract>.

B<NOTE> As of 0.16, no C<isa>/C<DOES> check on the argument is enforced.
It must be blessed, however.
This MAY change in the future.

=cut

sub set_parent {
    my ($self, $parent) = @_;

    if (blessed $parent) {
        $self->{parent} = $parent;
        # avoid a circular loop because $self is likely to be stored
        # in parent as subcontract
        weaken $self->{parent};
    } elsif (!defined $parent) {
        delete $self->{parent};
    } else {
        $self->_croak('parent must be a Report object, not a '.(ref $parent || 'scalar'))
    };
    return $self;
};

=head2 get_parent

t/119-get_parent.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use Test::More;
use Scalar::Util qw( weaken refaddr );

use Assert::Refute::Report;

my $parent = Assert::Refute::Report->new;

$parent->subcontract("inner test" => sub {
    my $inner = shift;

    $inner->ok(1);
});

my $details = $parent->get_result_details(1);

my $child = $details->{subcontract};

isa_ok $child, "Assert::Refute::Report";

is refaddr $child->get_parent, refaddr $parent, "subcontract retains parent";

weaken $parent;

is $parent, undef, "report is not leaky";
is $child->get_parent, undef, "parent updated";

done_testing;

t/120-set_parent.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use Test::More;
use Scalar::Util qw( weaken refaddr );

use Assert::Refute::Report;

my $child  = Assert::Refute::Report->new;
my $parent = Assert::Refute::Report->new;

is $child->get_parent, undef, "initial parent is null";

is refaddr( $child->set_parent( $parent ) ), refaddr $child, "set_parent returns self";
is refaddr( $child->get_parent ), refaddr $parent, "get_parent adjusted";