diff lib/IMPL/Test/Plan.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children 9335cf010b23
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Test/Plan.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,238 @@
+package IMPL::Test::Plan;
+use strict;
+use warnings;
+
+use parent 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} = [$Unit->List];
+        } otherwise {
+            my $err = $@; 
+            $Unit = $info{Unit} = new IMPL::Test::BadUnit(
+                $Unit->can('UnitName') ?
+                    $Unit->UnitName :
+                    $Unit,
+                "Failed to extract tests",
+                $err
+            );
+            $info{Tests} = [$Unit->List];
+        };
+        $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}}) {
+                my $name = $test->Name;
+                
+                #protected creation of the test
+                $test = eval { $info->{Unit}->new($test); } || new IMPL::Test::BadUnit(
+                    $info->{Unit}->can('UnitName') ?
+                        $info->{Unit}->UnitName :
+                        $info->{Unit},
+                    "Failed to construct the test $name",
+                    $@
+                );
+                
+                # invoke the test
+                $this->_Tell(RunTest => $test);
+                my $result = $test->Run($data);
+                $this->_Tell(EndTest => $test,$result);
+                
+                push @results,$result;
+            }
+        } else {
+            my $e = $@;
+            my $badTest = new IMPL::Test::BadUnit(
+                $info->{Unit}->can('UnitName') ?
+                    $info->{Unit}->UnitName :
+                    $info->{Unit},
+                "Failed to initialize the unit",
+                $@
+            ); 
+            foreach my $test (@{$info->{Tests}}) {
+                
+                $this->_Tell(RunTest => $badTest);
+                my $result = new IMPL::Test::Result(
+                    Name => $test->Name,
+                    State => IMPL::Test::Result::FAIL,
+                    Exception => $e
+                );
+                $this->_Tell(EndTest => $badTest,$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;