AFS
2 results

 view release on metacpan or  search on metacpan

src/inc/Test/Builder.pm  view on Meta::CPAN 

        die sprintf "You tried to plan twice!  Second plan at %s line %d\n",
          ($self->caller)[1,2];
    }

    if( $cmd eq 'no_plan' ) {
        $self->no_plan;
    }
    elsif( $cmd eq 'skip_all' ) {
        return $self->skip_all($arg);
    }
    elsif( $cmd eq 'tests' ) {
        if( $arg ) {
            return $self->expected_tests($arg);
        }
        elsif( !defined $arg ) {
            die "Got an undefined number of tests.  Looks like you tried to ".
                "say how many tests you plan to run but made a mistake.\n";
        }
        elsif( !$arg ) {
            die "You said to run 0 tests!  You've got to run something.\n";
        }
    }
    else {
        require Carp;
        my @args = grep { defined } ($cmd, $arg);
        Carp::croak("plan() doesn't understand @args");
    }

    return 1;
}


my $Expected_Tests = 0;
sub expected_tests {
    my($self, $max) = @_;

    if( defined $max ) {
        $Expected_Tests = $max;
        $Have_Plan      = 1;

        $self->_print("1..$max\n") unless $self->no_header;
    }
    return $Expected_Tests;
}

src/inc/Test/Builder.pm  view on Meta::CPAN 

    $out .= "\n";

    $Skip_All = 1;

    $self->_print($out) unless $self->no_header;
    exit(0);
}


sub ok {
    my($self, $test, $name) = @_;

    # $test might contain an object which we don't want to accidentally
    # store, so we turn it into a boolean.
    $test = $test ? 1 : 0;

    unless( $Have_Plan ) {
        require Carp;
        Carp::croak("You tried to run a test without a plan!  Gotta have a plan.");
    }

    lock $Curr_Test;
    $Curr_Test++;

    $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
    You named your test '$name'.  You shouldn't use numbers for your test names.
    Very confusing.
ERR

    my($pack, $file, $line) = $self->caller;

    my $todo = $self->todo($pack);

    my $out;
    my $result = {};
    share($result);

    unless( $test ) {
        $out .= "not ";
        @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
    }
    else {
        @$result{ 'ok', 'actual_ok' } = ( 1, $test );
    }

    $out .= "ok";
    $out .= " $Curr_Test" if $self->use_numbers;

    if( defined $name ) {
        $name =~ s|#|\\#|g;     # # in a name can confuse Test::Harness.
        $out   .= " - $name";
        $result->{name} = $name;
    }

src/inc/Test/Builder.pm  view on Meta::CPAN 

    else {
        $result->{reason} = '';
        $result->{type}   = '';
    }

    $Test_Results[$Curr_Test-1] = $result;
    $out .= "\n";

    $self->_print($out);

    unless( $test ) {
        my $msg = $todo ? "Failed (TODO)" : "Failed";
        $self->diag("    $msg test ($file at line $line)\n");
    } 

    return $test ? 1 : 0;
}


sub is_eq {
    my($self, $got, $expect, $name) = @_;
    local $Level = $Level + 1;

    if( !defined $got || !defined $expect ) {
        # undef only matches undef and nothing else
        my $test = !defined $got && !defined $expect;

        $self->ok($test, $name);
        $self->_is_diag($got, 'eq', $expect) unless $test;
        return $test;
    }

    return $self->cmp_ok($got, 'eq', $expect, $name);
}

sub is_num {
    my($self, $got, $expect, $name) = @_;
    local $Level = $Level + 1;

    if( !defined $got || !defined $expect ) {
        # undef only matches undef and nothing else
        my $test = !defined $got && !defined $expect;

        $self->ok($test, $name);
        $self->_is_diag($got, '==', $expect) unless $test;
        return $test;
    }

    return $self->cmp_ok($got, '==', $expect, $name);
}

sub _is_diag {
    my($self, $got, $type, $expect) = @_;

    foreach my $val (\$got, \$expect) {
        if( defined $$val ) {

src/inc/Test/Builder.pm  view on Meta::CPAN 


}    


sub isnt_eq {
    my($self, $got, $dont_expect, $name) = @_;
    local $Level = $Level + 1;

    if( !defined $got || !defined $dont_expect ) {
        # undef only matches undef and nothing else
        my $test = defined $got || defined $dont_expect;

        $self->ok($test, $name);
        $self->_cmp_diag('ne', $got, $dont_expect) unless $test;
        return $test;
    }

    return $self->cmp_ok($got, 'ne', $dont_expect, $name);
}

sub isnt_num {
    my($self, $got, $dont_expect, $name) = @_;
    local $Level = $Level + 1;

    if( !defined $got || !defined $dont_expect ) {
        # undef only matches undef and nothing else
        my $test = defined $got || defined $dont_expect;

        $self->ok($test, $name);
        $self->_cmp_diag('!=', $got, $dont_expect) unless $test;
        return $test;
    }

    return $self->cmp_ok($got, '!=', $dont_expect, $name);
}



sub like {
    my($self, $this, $regex, $name) = @_;

src/inc/Test/Builder.pm  view on Meta::CPAN 

    my $ok = 0;
    my $usable_regex = $self->maybe_regex($regex);
    unless (defined $usable_regex) {
        $ok = $self->ok( 0, $name );
        $self->diag("    '$regex' doesn't look much like a regex to me.");
        return $ok;
    }

    {
        local $^W = 0;
        my $test = $this =~ /$usable_regex/ ? 1 : 0;
        $test = !$test if $cmp eq '!~';
        $ok = $self->ok( $test, $name );
    }

    unless( $ok ) {
        $this = defined $this ? "'$this'" : 'undef';
        my $match = $cmp eq '=~' ? "doesn't match" : "matches";
        $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
                  %s
    %13s '%s'
DIAGNOSTIC

    }

    return $ok;
}


sub cmp_ok {
    my($self, $got, $type, $expect, $name) = @_;

    my $test;
    {
        local $^W = 0;
        local($@,$!);   # don't interfere with $@
                        # eval() sometimes resets $!
        $test = eval "\$got $type \$expect";
    }
    local $Level = $Level + 1;
    my $ok = $self->ok($test, $name);

    unless( $ok ) {
        if( $type =~ /^(eq|==)$/ ) {
            $self->_is_diag($got, $type, $expect);
        }
        else {
            $self->_cmp_diag($got, $type, $expect);
        }
    }
    return $ok;

src/inc/Test/Builder.pm  view on Meta::CPAN 

    exit 255;
}


sub skip {
    my($self, $why) = @_;
    $why ||= '';

    unless( $Have_Plan ) {
        require Carp;
        Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
    }

    lock($Curr_Test);
    $Curr_Test++;

    my %result;
    share(%result);
    %result = (
        'ok'      => 1,
        actual_ok => 1,

src/inc/Test/Builder.pm  view on Meta::CPAN 

}



sub todo_skip {
    my($self, $why) = @_;
    $why ||= '';

    unless( $Have_Plan ) {
        require Carp;
        Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
    }

    lock($Curr_Test);
    $Curr_Test++;

    my %result;
    share(%result);
    %result = (
        'ok'      => 1,
        actual_ok => 0,

src/inc/Test/Builder.pm  view on Meta::CPAN 

    print $fh @msgs;

    return 0;
}


sub _print {
    my($self, @msgs) = @_;

    # Prevent printing headers when only compiling.  Mostly for when
    # tests are deparsed with B::Deparse
    return if $^C;

    local($\, $", $,) = (undef, ' ', '');
    my $fh = $self->output;

    # Escape each line after the first with a # so we don't
    # confuse Test::Harness.
    foreach (@msgs) {
        s/\n(.)/\n# $1/sg;
    }

src/inc/Test/Builder.pm  view on Meta::CPAN 

    return $Todo_FH;
}

sub _new_fh {
    my($file_or_fh) = shift;

    my $fh;
    unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
        $fh = do { local *FH };
        open $fh, ">$file_or_fh" or 
            die "Can't open test output log $file_or_fh: $!";
    }
    else {
        $fh = $file_or_fh;
    }

    return $fh;
}

unless( $^C ) {
    # We dup STDOUT and STDERR so people can change them in their
    # test suites while still getting normal test output.
    open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
    open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";

    # Set everything to unbuffered else plain prints to STDOUT will
    # come out in the wrong order from our own prints.
    _autoflush(\*TESTOUT);
    _autoflush(\*STDOUT);
    _autoflush(\*TESTERR);
    _autoflush(\*STDERR);

src/inc/Test/Builder.pm  view on Meta::CPAN 


sub _autoflush {
    my($fh) = shift;
    my $old_fh = select $fh;
    $| = 1;
    select $old_fh;
}



sub current_test {
    my($self, $num) = @_;

    lock($Curr_Test);
    if( defined $num ) {
        unless( $Have_Plan ) {
            require Carp;
            Carp::croak("Can't change the current test number without a plan!");
        }

        $Curr_Test = $num;
        if( $num > @Test_Results ) {
            my $start = @Test_Results ? $#Test_Results + 1 : 0;
            for ($start..$num-1) {
                my %result;
                share(%result);
                %result = ( ok        => 1, 
                            actual_ok => undef, 
                            reason    => 'incrementing test number', 
                            type      => 'unknown', 
                            name      => undef 
                          );
                $Test_Results[$_] = \%result;
            }
        }
    }
    return $Curr_Test;
}

src/inc/Test/Builder.pm  view on Meta::CPAN 


sub caller {
    my($self, $height) = @_;
    $height ||= 0;

    my @caller = CORE::caller($self->level + $height + 1);
    return wantarray ? @caller : $caller[0];
}

sub _sanity_check {
    _whoa($Curr_Test < 0,  'Says here you ran a negative number of tests!');
    _whoa(!$Have_Plan and $Curr_Test, 
          'Somehow your tests ran without a plan!');
    _whoa($Curr_Test != @Test_Results,
          'Somehow you got a different number of results than tests ran!');
}


sub _whoa {
    my($check, $desc) = @_;
    if( $check ) {
        die <<WHOA;
WHOA!  $desc
This should never happen!  Please contact the author immediately!
WHOA

src/inc/Test/Builder.pm  view on Meta::CPAN 

            share(%empty_result);
            $Test_Results[$idx] = \%empty_result
              unless defined $Test_Results[$idx];
        }

        my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
        $num_failed += abs($Expected_Tests - @Test_Results);

        if( $Curr_Test < $Expected_Tests ) {
            $self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
FAIL
        }
        elsif( $Curr_Test > $Expected_Tests ) {
            my $num_extra = $Curr_Test - $Expected_Tests;
            $self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but ran $num_extra extra.
FAIL
        }
        elsif ( $num_failed ) {
            $self->diag(<<"FAIL");
Looks like you failed $num_failed tests of $Expected_Tests.
FAIL
        }

        if( $Test_Died ) {
            $self->diag(<<"FAIL");
Looks like your test died just after $Curr_Test.
FAIL

            _my_exit( 255 ) && return;
        }

        _my_exit( $num_failed <= 254 ? $num_failed : 254  ) && return;
    }
    elsif ( $Skip_All ) {
        _my_exit( 0 ) && return;
    }
    elsif ( $Test_Died ) {
        $self->diag(<<'FAIL');
Looks like your test died before it could output anything.
FAIL
    }
    else {
        $self->diag("No tests run!\n");
        _my_exit( 255 ) && return;
    }
}

END {
    $Test->_ending if defined $Test and !$Test->no_ending;
}


1;

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

}

sub import {
    my($class) = shift;
    goto &plan;
}



sub ok ($;$) {
    my($test, $name) = @_;
    $Test->ok($test, $name);
}


sub is ($$;$) {
    $Test->is_eq(@_);
}

sub isnt ($$;$) {
    $Test->isnt_eq(@_);
}

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

    }

    return $ok;
}

sub skip {
    my($why, $how_many) = @_;

    unless( defined $how_many ) {
        # $how_many can only be avoided when no_plan is in use.
        _carp "skip() needs to know \$how_many tests are in the block"
          unless $Test::Builder::No_Plan;
        $how_many = 1;
    }

    for( 1..$how_many ) {
        $Test->skip($why);
    }

    local $^W = 0;
    last SKIP;
}



sub todo_skip {
    my($why, $how_many) = @_;

    unless( defined $how_many ) {
        # $how_many can only be avoided when no_plan is in use.
        _carp "todo_skip() needs to know \$how_many tests are in the block"
          unless $Test::Builder::No_Plan;
        $how_many = 1;
    }

    for( 1..$how_many ) {
        $Test->todo_skip($why);
    }

    local $^W = 0;
    last TODO;



( run in 1.021 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )