view Lib/IMPL/Test/Plan.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 2e546a5175dd
children 16ada169ca75
line wrap: on
line source

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

use base qw(IMPL::Object);
use IMPL::Class::Property;

use IMPL::Exception;
use IMPL::Test::Result;
use IMPL::Test::BadUnit;
use Error qw(:try);

use IMPL::Serialization;
use IMPL::Serialization::XmlFormatter;

BEGIN {
    public property Units => prop_all | prop_list;
    public property Results => prop_all | prop_list;
    public property Listeners => prop_all | prop_list;
    private property _Cache => prop_all | prop_list;
    private property _Count => prop_all;
}

sub CTOR {
    my $this = shift;
    $this->Units(\@_);
}

sub restore {
    my ($class,$data,$instance) = @_;
    
    $instance ||= $class->surrogate;
    
    $instance->callCTOR();
    
    my %args = @$data;
    
    $instance->Units($args{Units});
    $instance->Results($args{Results}) if $args{Results};
    $instance->Listeners($args{Listeners}) if $args{Listeners};
}

sub save {
    my ($this,$ctx) = @_;
    
    $ctx->AddVar(Units => [$this->Units]);
    $ctx->AddVar(Results => [$this->Results]) if $this->Results;
    $ctx->AddVar(Listeners => [$this->Listeners]) if $this->Listeners;
}

sub AddListener {
    my ($this,$listener) = @_;
    
    $this->Listeners($this->Listeners,$listener);
}

sub Prepare {
    my ($this) = @_;
    
    my $count = 0;
    my @cache;
    
    foreach my $Unit ($this->Units){
        my %info;
        
        # preload module
        undef $@;
        
        eval "require $Unit" unless (ref $Unit);
        
        # handle loading errors
        $Unit = new IMPL::Test::BadUnit($Unit,"Failed to load unit",$@) if $@;
        
        $info{Unit} = $Unit;
        try {
            $info{Tests} = [map $Unit->new($_), $Unit->List];
        } otherwise {
            $info{Tests} = [$info{Unit} = new IMPL::Test::BadUnit($Unit->can('UnitName') ? $Unit->UnitName : $Unit,"Failed to extract tests",$@)];
        };
        $count += @{$info{Tests}};
        push @cache, \%info if @{$info{Tests}};
    }
    
    $this->_Count($count);
    $this->_Cache(\@cache);
}

sub Count {
    my ($this) = @_;
    return $this->_Count;
}

sub Run {
    my $this = shift;
    
    die new IMPL::InvalidOperationException("You must call the prepare method before running the plan") unless $this->_Cache;
    
    $this->_Tell(RunPlan => $this);
    
    my @resultsTotal;
    
    foreach my $info ($this->_Cache) {
        $this->_Tell(RunUnit => $info->{Unit});
        
        my $data;
        undef $@;
        eval {
            $data = $info->{Unit}->StartUnit;
        };
        
        my @results;
        
        if (not $@) {
            foreach my $test (@{$info->{Tests}}) {
                $this->_Tell(RunTest => $test);
                my $result = $test->Run($data);
                $this->_Tell(EndTest => $test,$result);
                push @results,$result;
            }
        } else {
            my $e = $@;
            foreach my $test (@{$info->{Tests}}) {
                $this->_Tell(RunTest => $test);
                my $result = new IMPL::Test::Result(
                    Name => $test->Name,
                    State => IMPL::Test::Result::FAIL,
                    Exception => $e
                );
                $this->_Tell(EndTest => $test,$result);
                push @results,$result;
            }
        }
        
        eval {
            $info->{Unit}->FinishUnit($data);
        };
        
        undef $@;
        
        push @resultsTotal, { Unit => $info->{Unit}, Results => \@results};
        
        $this->_Tell(EndUnit => $info->{Unit},\@results);
    }
    
    $this->Results(\@resultsTotal);
    $this->_Tell(EndPlan => $this);
}

sub _Tell {
    my ($this,$what,@args) = @_;
    
    $_->$what(@args) foreach $this->Listeners;
}

sub SaveXML {
    my ($this,$out) = @_;
    
    my $h;
    
    if (ref $out eq 'GLOB') {
        $h = $out;
    } elsif ($out and not ref $out) {
        open $h, ">", $out or die new IMPL::Exception("Failed to open file",$out);
    } else {
        die new IMPL::InvalidOperationException("Invalid output specified");
    }
    
    my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
    $s->Serialize($h,$this);
}

sub LoadXML {
    my ($self,$in) = @_;
    
    my $h;
    
    if (ref $in eq 'GLOB') {
        $h = $in;
    } elsif ($in and not ref $in) {
        open $h, ">", $in or die new IMPL::Exception("Failed to open file",$in);
    } else {
        die new IMPL::InvalidOperationException("Invalid input specified");
    }
    
    my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
    return $s->Deserialize($h);
}

sub xml {
    my $this = shift;
    my $str = '';
    
    open my $h,'>',\$str or die new IMPL::Exception("Failed to create stream");
    $this->SaveXML($h);
    undef $h;
    return $str;
}

sub LoadXMLString {
    my $self = shift;
    my $str = shift;
    
    open my $h,'<',\$str or die new IMPL::Exception("Failed to create stream");
    return $self->LoadXML($h);
}


1;