Oktest

 view release on metacpan or  search on metacpan

lib/Oktest.pm  view on Meta::CPAN

    return $so;
}

sub _set_fixture {
    my ($name, $block) = @_;
    my $to = $Oktest::TopicObject::__current
        or die "$name() should be called in topic block.";
    $to->$name($block);
}

sub before(&) {
    _set_fixture('before', @_);
}

sub after(&) {
    _set_fixture('after', @_);
}

sub before_all(&) {
    _set_fixture('before_all', @_);
}

sub after_all(&) {
    _set_fixture('after_all', @_);
}

sub at_end(&) {
    my ($block) = @_;
    ## todo: check whether at_end() is called in spec block.
    push(@Oktest::__at_end_blocks, $block);
}

sub __at_end_of_spec {
    ## run closures in reverse order
    for my $block (reverse(@Oktest::__at_end_blocks)) {
        $block->();
    }

lib/Oktest.pm  view on Meta::CPAN

    $reporter->{report_skipped} ||= $opts{report_skipped};
    $reporter->{report_todo}    ||= $opts{report_todo};
    my @topics = @Oktest::TopicObject::__tops;
    $runner->run_all(@topics);
}

sub main {
    Oktest::MainApp->new(@_)->execute();
}

sub with(&) {
    my ($block) = @_;
    return $block;
}

sub __clear {
    @__assertion_objects = ();
    Oktest::TopicObject::__clear();
}

sub __at_exit {

lib/Oktest.pm  view on Meta::CPAN

        last if ! $filename || $filename eq __FILE__;
        $str .= "File '$filename', line $linenum:\n";
        if (-f $filename) {
            my $line = Oktest::Util::read_line_from($filename, $linenum);
            $str .= "    " . Oktest::Util::strip($line) . "\n";
        }
    }
    return $str;
}

sub _assert(&@) {
    my ($closure, $op, $validate, $this, $expected) = @_;
    $this->_done();
    if ($validate) {
        my $msg = $this->_validate_expected($expected, $op);
        die $msg if $msg;
    }
    #unless (defined($expected)) {
    #    my $msg =
    #        "[ERROR] OK() $op \$expected: \$expected is undefined value.\n" .
    #        "  \$expected: " . _repr($expected);

lib/Oktest.pm  view on Meta::CPAN

    my (@arr) = @_;
    return $arr[$#arr] if @arr;
    return;
}

sub length {
    my (@arr) = @_;
    return $#arr + 1;
}

sub index(&@) {
    my ($block, @arr) = @_;
    my $i = 0;
    for (@arr) {
        return $i if $block->($_);
        $i++;
    }
    return -1;
}

sub index_denied(&@) {
    my ($block, @arr) = @_;
    my $i = 0;
    for (@arr) {
        return $i unless $block->($_);
        $i++;
    }
    return -1;
}

sub is_string {

lib/Oktest.pm  view on Meta::CPAN

    open3($IN, $OUT, $ERR, $command);
    print $IN $input if $input;
    close $IN;
    my @output = <$OUT>;
    my @error  = <$ERR>;
    close $OUT;
    close $ERR;
    return join("", @output), join("", @error);
}

sub capture(&) {
    my ($block) = @_;
    my $sout = tie(local *STDOUT, 'Oktest::Util::__PrintHandler');
    local *STDERR = *STDOUT;
    $block->();
    return $sout->output;
}

sub capture_stdouterr(&) {
    my ($block) = @_;
    my $sout = tie(local *STDOUT, 'Oktest::Util::__PrintHandler');
    my $serr = tie(local *STDERR, 'Oktest::Util::__PrintHandler');
    $block->();
    return ($sout->output, $serr->output);
}

sub capture_stdout(&) {
    my ($block) = @_;
    my $sout = tie(local *STDOUT, 'Oktest::Util::__PrintHandler');
    $block->();
    return $sout->output;
}

sub capture_stderr(&) {
    my ($block) = @_;
    my $serr = tie(local *STDERR, 'Oktest::Util::__PrintHandler');
    $block->();
    return $serr->output;
}

$INC{'Oktest/Util.pm'} = __FILE__;

lib/Oktest.pm  view on Meta::CPAN

#sub eq_hash {
#    my ($this, $that) = @_;
#    Oktest::OK ($this)->equals($that);
#}
#
#sub eq_set {
#    my ($this, $that) = @_;
#    Oktest::OK ($this)->equals($that);
#}

sub throws_ok(&$;$) {
    my ($coderef, $pattern, $description) = @_;
    Oktest::OK ($coderef)->dies($pattern);
    return 1==1;
}

sub dies_ok(&;$) {
    my ($coderef, $description) = @_;
    Oktest::OK ($coderef)->dies();
    return 1==1;
}

sub lives_ok(&;$) {
    my ($coderef, $description) = @_;
    Oktest::OK ($coderef)->not_die();
    return 1==1;
}

sub lives_and(&;$) {
    my ($test, $description) = @_;
    Oktest::OK ($test)->not_die();
    return 1==1;
}

sub warning_like(&$;$) {
    my ($coderef, $pattern, $test_name) = @_;
    Oktest::OK ($coderef)->warns($pattern);
    return 1==1;
}

sub diag {
    my ($message) = @_;
    print STDOUT "# $message\n";
    return 0==1;
}