File Coverage

blib/lib/Test/Should/Engine.pm

Criterion	Covered	Total	%
statement	49	50	98.0
branch	39	40	97.5
condition	3	3	100.0
subroutine	6	6	100.0
pod	1	1	100.0
total	98	100	98.0

package Test::Should::Engine;
use strict;
use warnings;
use 5.010001;
our $VERSION = '0.04';

use Carp ();
use Storable ();

our @CARP_NOT = (__PACKAGE__);

sub run {
    my ($class, $pattern, $subject, @args) = @_;

    if ($pattern =~ /^should_not_(.+)$/) {
        $pattern = "should_$1";
        return !$class->run($pattern, $subject, @args);
    } elsif ($pattern eq 'should_be_ok' || $pattern eq 'should_be_true') {
        return !!$subject;
    } elsif ($pattern eq 'should_be_false') {
        return !$subject;
    } elsif ($pattern eq 'should_be_undef') {
        return not defined($subject);
    } elsif ($pattern eq 'should_be_empty') {
        if (ref $subject eq 'ARRAY') {
            return (@$subject == 0);
        } else {
            return length($subject) == 0;
        }
    } elsif ($pattern eq 'should_be_equal') {
        local $Storable::canonical = 1;
        return Storable::nfreeze(\$subject) eq Storable::nfreeze(\$args[0]);
    } elsif ($pattern =~ /^should_be_an?$/) {
        return UNIVERSAL::isa($subject, $args[0]);
    } elsif ($pattern eq 'should_be_above') {
        return $subject > $args[0];
    } elsif ($pattern eq 'should_be_below') {
        return $subject < $args[0];
    } elsif ($pattern eq 'should_match') {
        return !!($subject =~ $args[0]);
    } elsif ($pattern eq 'should_have_length') {
        if (ref $subject eq 'ARRAY') {
            return (@$subject == $args[0]);
        } else {
            return length($subject) == $args[0];
        }
    } elsif ($pattern eq 'should_include') {
        if (ref $subject eq 'ARRAY') {
            for (@$subject) {
                return 1 if $_ eq $args[0];
            }
            return 0;
        } else {
            return index($subject, $args[0]) >= 0;
        }
    } elsif ($pattern eq 'should_throw') {
        eval {
            $subject->()
        };
        if (ref $args[0] eq 'Regexp') {
            return $@ =~ $args[0];
        } else {
            return !!$@;
        }
    } elsif ($pattern eq 'should_have_keys') {
        my %copy = %$subject;
        for (@args) {
            return 0 unless exists $copy{$_};
            delete $copy{$_};
        }
        return keys(%copy) == 0;
    } else {
        Carp::croak("Unknown pattern: $pattern");
    }
}

1;
__END__