view Lib/IMPL/Test/BadUnit.pm @ 94:79bf75223afe

Fixed security related bugs
author wizard
date Thu, 29 Apr 2010 01:31:27 +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;