diff Lib/IMPL/Test/Plan.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 2e546a5175dd
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Test/Plan.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,200 @@
+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;
+        
+        $info{Unit} = $Unit;
+        try {
+            $info{Tests} = [map $Unit->new($_), $Unit->List];
+        } otherwise {
+            $info{Tests} = [$info{Unit} = new IMPL::Test::BadUnit($Unit->UnitName,"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;