view Lib/IMPL/Test/TAPListener.pm @ 166:4267a2ac3d46

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:12:06 +0400
parents 52eeec77504b
children
line wrap: on
line source

package IMPL::Test::TAPListener;
use strict;
use warnings;

use parent qw(IMPL::Object IMPL::Object::Serializable);
use IMPL::Class::Property;
use IMPL::Test::Result;

BEGIN {
    private property _Output => prop_all;
    private property _testNo => prop_all;
}

sub CTOR {
    my ($this,$out) = @_;
    
    $this->_Output($out || *STDOUT);
    $this->_testNo(1);
}

sub RunPlan {
    my ($this,$plan) = @_;
    
    my $out = $this->_Output;
    
    print $out "1..",$plan->Count,"\n";
}

sub EndPlan {
    
}

sub RunUnit {
    my ($this,$unit) = @_;
    
    my $out = $this->_Output;
    
    print $out "#\n",join("\n",map "# $_", split /\n/, "Running unit: " . $unit->UnitName, ),"\n#\n";
}

sub EndUnit {
    
}

sub RunTest {
    
}

sub EndTest {
    my ($this,$test,$result) = @_;
    
    my $out = $this->_Output;
    my $n = $this->_testNo;
    
    $this->_testNo($n+1);
    
    print $out (
            $result->State == IMPL::Test::Result::SUCCESS ?
            "ok $n " . join("\n# ", split(/\n/, $result->Name) )
                :
           (eval { $result->Exception->isa('IMPL::Test::SkipException') } ? "ok $n #SKIP: " : "not ok $n ") . join("\n# ", split(/\n/, $result->Name.": ".$result->Exception || '') )
        ),"\n";
        
}

sub save {
    
}

1;