view release on metacpan or  search on metacpan

lib/Test/Lazy/Tester.pm  view on Meta::CPAN

	else {
        my $structure = ref $expect eq "ARRAY" || ref $expect eq "HASH";
        my $scalar = ! $structure;

        my $cmp_source = $scalar ? $self->cmp_scalar : $self->cmp_structure;

		die "Don't know how to compare via ($compare)" unless $cmp = $cmp_source->{$cmp};
        local $Test::Builder::Level = $Test::Builder::Level + 1;
		$cmp->($got, $expect, $notice);
	}
}

sub check {
    my $self = shift;
	my ($got, $compare, $expect, $notice) = @_;
    my $length = @_;

	my $left = $self->render_value($got);
	my $right = $self->render_value($expect);
    $notice = $self->render_notice($left, $compare, $right, $notice, $length);

    local $Test::Builder::Level = $Test::Builder::Level + 1;

	return $self->_test($compare, $got, $expect, $notice);
}

sub try {
    my $self = shift;
	my ($statement, $compare, $expect, $notice) = @_;
    my $length = @_;

	my @got = ref $statement eq "CODE" ? $statement->() : eval $statement;
	die "$statement: $@" if $@;
	my $got;
	if (@got > 1) {
		if (ref $expect eq "ARRAY") {
			$got = \@got;
		}
		elsif (ref $expect eq "HASH") {
			$got = { @got };
		}
		else {
			$got = scalar @got;
		}
	}
	else {
		if (ref $expect eq "ARRAY" && (! @got || ref $got[0] ne "ARRAY")) {
			$got = \@got;
		}
		elsif (ref $expect eq "HASH" && ! @got) {
			$got = { };
		}
		else {
			$got = $got[0];
		}
	}
	
    my $left;
	if (ref $statement eq "CODE" && $deparser) {
		my $deparse = $deparser->coderef2text($statement);
		my @deparse = split m/\n\s*/, $deparse;
		$deparse = join ' ', "sub", @deparse if 3 == @deparse;
		$left = $deparse;
	}
	else {
		$left = $statement;
	}
	my $right = $self->render_value($expect);
    $notice = $self->render_notice($left, $compare, $right, $notice, $length);

    local $Test::Builder::Level = $Test::Builder::Level + 1;

	return $self->_test($compare, $got, $expect, $notice);
}

sub template {
    my $self = shift;
    require Test::Lazy::Template;
	return Test::Lazy::Template->new($self, @_);
}

1;