view Lib/IMPL/Test/BadUnit.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
parents 16ada169ca75
children 4267a2ac3d46
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;