view release on metacpan or  search on metacpan

inc/Test/More.pm  view on Meta::CPAN

#line 1
package Test::More;

use 5.006;
use strict;


# Can't use Carp because it might cause use_ok() to accidentally succeed
# even though the module being used forgot to use Carp.  Yes, this
# actually happened.
sub _carp {
    my($file, $line) = (caller(1))[1,2];
    warn @_, " at $file line $line\n";
}



use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
$VERSION = '0.80';
$VERSION = eval $VERSION;    # make the alpha version come out as a number

use Test::Builder::Module;
@ISA    = qw(Test::Builder::Module);
@EXPORT = qw(ok use_ok require_ok
             is isnt like unlike is_deeply
             cmp_ok
             skip todo todo_skip
             pass fail
             eq_array eq_hash eq_set
             $TODO
             plan
             can_ok  isa_ok
             diag
             BAIL_OUT
            );


#line 156

sub plan {
    my $tb = Test::More->builder;

    $tb->plan(@_);
}


# This implements "use Test::More 'no_diag'" but the behavior is
# deprecated.
sub import_extra {
    my $class = shift;
    my $list  = shift;

    my @other = ();
    my $idx = 0;
    while( $idx <= $#{$list} ) {
        my $item = $list->[$idx];

        if( defined $item and $item eq 'no_diag' ) {
            $class->builder->no_diag(1);
        }
        else {
            push @other, $item;
        }

        $idx++;
    }

    @$list = @other;
}


#line 256

sub ok ($;$) {
    my($test, $name) = @_;
    my $tb = Test::More->builder;

    $tb->ok($test, $name);
}

inc/Test/More.pm  view on Meta::CPAN

            my $ref = ref $object;
            $diag = "$obj_name isn't a '$class' it's a '$ref'";
        }
    }
            
      

    my $ok;
    if( $diag ) {
        $ok = $tb->ok( 0, $name );
        $tb->diag("    $diag\n");
    }
    else {
        $ok = $tb->ok( 1, $name );
    }

    return $ok;
}


#line 591

sub pass (;$) {
    my $tb = Test::More->builder;
    $tb->ok(1, @_);
}

sub fail (;$) {
    my $tb = Test::More->builder;
    $tb->ok(0, @_);
}

#line 652

sub use_ok ($;@) {
    my($module, @imports) = @_;
    @imports = () unless @imports;
    my $tb = Test::More->builder;

    my($pack,$filename,$line) = caller;

    my $code;
    if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
        # probably a version check.  Perl needs to see the bare number
        # for it to work with non-Exporter based modules.
        $code = <<USE;
package $pack;
use $module $imports[0];
1;
USE
    }
    else {
        $code = <<USE;
package $pack;
use $module \@{\$args[0]};
1;
USE
    }


    my($eval_result, $eval_error) = _eval($code, \@imports);
    my $ok = $tb->ok( $eval_result, "use $module;" );
    
    unless( $ok ) {
        chomp $eval_error;
        $@ =~ s{^BEGIN failed--compilation aborted at .*$}
                {BEGIN failed--compilation aborted at $filename line $line.}m;
        $tb->diag(<<DIAGNOSTIC);
    Tried to use '$module'.
    Error:  $eval_error
DIAGNOSTIC

    }

    return $ok;
}


sub _eval {
    my($code) = shift;
    my @args = @_;

    # Work around oddities surrounding resetting of $@ by immediately
    # storing it.
    local($@,$!,$SIG{__DIE__});   # isolate eval
    my $eval_result = eval $code;
    my $eval_error  = $@;

    return($eval_result, $eval_error);
}

#line 718

sub require_ok ($) {
    my($module) = shift;
    my $tb = Test::More->builder;

    my $pack = caller;

    # Try to deterine if we've been given a module name or file.
    # Module names must be barewords, files not.
    $module = qq['$module'] unless _is_module_name($module);

    my $code = <<REQUIRE;
package $pack;
require $module;
1;
REQUIRE

    my($eval_result, $eval_error) = _eval($code);
    my $ok = $tb->ok( $eval_result, "require $module;" );

    unless( $ok ) {
        chomp $eval_error;
        $tb->diag(<<DIAGNOSTIC);
    Tried to require '$module'.
    Error:  $eval_error
DIAGNOSTIC

    }

    return $ok;
}


sub _is_module_name {
    my $module = shift;

    # Module names start with a letter.
    # End with an alphanumeric.
    # The rest is an alphanumeric or ::
    $module =~ s/\b::\b//g;
    $module =~ /^[a-zA-Z]\w*$/;
}

#line 795

use vars qw(@Data_Stack %Refs_Seen);
my $DNE = bless [], 'Does::Not::Exist';

sub _dne {
    ref $_[0] eq ref $DNE;
}


sub is_deeply {
    my $tb = Test::More->builder;

    unless( @_ == 2 or @_ == 3 ) {
        my $msg = <<WARNING;
is_deeply() takes two or three args, you gave %d.
This usually means you passed an array or hash instead 
of a reference to it
WARNING
        chop $msg;   # clip off newline so carp() will put in line/file

        _carp sprintf $msg, scalar @_;

	return $tb->ok(0);
    }

    my($got, $expected, $name) = @_;

    $tb->_unoverload_str(\$expected, \$got);

    my $ok;
    if( !ref $got and !ref $expected ) {  		# neither is a reference
        $ok = $tb->is_eq($got, $expected, $name);
    }
    elsif( !ref $got xor !ref $expected ) {  	# one's a reference, one isn't
        $ok = $tb->ok(0, $name);
	$tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
    }
    else {			       		# both references
        local @Data_Stack = ();
        if( _deep_check($got, $expected) ) {
            $ok = $tb->ok(1, $name);