view Lib/IMPL/Test/BadUnit.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 03e58a454b20
children 16ada169ca75
line wrap: on
line source

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

use base qw(IMPL::Test::Unit);
use IMPL::Class::Property;

BEGIN {
    public property UnitName => prop_all;
    public property Message => prop_all;
    public property Error => prop_all;
}

our %CTOR = (
    'IMPL::Test::Unit' => sub {
        if (@_>1) {
            # Unit construction
            my ($unit,$message,$error) = @_;
            return new IMPL::Test::Unit::TestInfo(
                BadUnitTest => sub {
                    die new IMPL::Test::FailException($message,$unit,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error)
                }
            );
        } else {
            # test construction
            return @_;
        }
    }
);

sub CTOR {
    my ($this,$name,$message,$error) = @_;
    
    $this->UnitName($name);
    $this->Message($message);
    $this->Error($error);
}

sub save {
    my ($this,$ctx) = @_;
    
    defined ($this->$_()) and $ctx->AddVar($_ => $this->$_()) foreach qw(UnitName Message);
}

sub restore {
    my ($class,$data,$inst) = @_;
    
    my %args = @$data;
    
    $inst ||= $class->surrogate;
    $inst->callCTOR(@args{qw(UnitName Message)});
}

sub List {
    my ($this) = @_;
    my $error = $this->Error;
    return new IMPL::Test::Unit::TestInfo(
        BadUnitTest => sub {
            die new IMPL::Test::FailException($this->Message,$this->UnitName,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error)
        }
    );
}


1;