Mercurial > pub > Impl
view Lib/IMPL/Test/BadUnit.pm @ 104:196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
Minor and major fixes almost for everything.
A 'Source' property of the ValidationErrors generated from a NodeSet or a NodeList is subject to change in the future.
author | wizard |
---|---|
date | Tue, 11 May 2010 02:42:59 +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;