view Lib/IMPL/Test.pm @ 381:ced5937ff21a

Custom getters/setters support method names in theirs definitions Initial support for localizable labels in DOM schemas
author cin
date Wed, 22 Jan 2014 16:56:10 +0400
parents 546957c50a36
children
line wrap: on
line source

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

use IMPL::lang qw(equals_s);
use IMPL::Const qw(:access);
require IMPL::Test::SkipException;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(&test &shared &failed &cmparray &skip &run_plan &assert &assertarray &GetCallerSourceLine);

require IMPL::Test::Unit;
require IMPL::Test::Plan;
require IMPL::Test::TAPListener;

sub test($$) {
    my ($name,$code) = @_;
    my $class = caller;
    
    $class->set_meta(
        new IMPL::Test::Unit::TestInfo( $name, $code )
    );
}

sub shared($) {
    my ($propInfo) = @_;
    
    my $class = caller;
    
    die new IMPL::Exception("Only properties could be declared as shared",$propInfo->name) unless eval {$propInfo->isa('IMPL::Class::PropertyInfo')};
    die new IMPL::Exception("You can't mark the readonly property as shared",$propInfo->name) unless $propInfo->setter;
    die new IMPL::Exception("Only public properties could be declared as shared",$propInfo->name) unless $propInfo->access == ACCESS_PUBLIC;
    
    $class->set_meta(new IMPL::Test::Unit::SharedData($propInfo->name));
}

sub failed($;@) {
    die new IMPL::Test::FailException(@_);
}

sub assert {
    my ($condition,@params) = @_;
    
    die new IMPL::Test::FailException(@params ? @params : ("Assertion failed" , _GetSourceLine( (caller)[1,2] )) ) unless $condition;
}

sub skip($;@) {
    die new IMPL::Test::SkipException(@_);
}

sub cmparray {
    my ($a,$b) = @_;
    
    return 0 unless @$a == @$b;
    
    for (my $i=0; $i < @$a; $i++ ) {
        return 0 unless
            equals_s($a->[$i], $b->[$i]);
    }
    
    return 1;
}

sub assertarray {
    my ($a,$b) = @_;
    
    
    die IMPL::Test::FailException->new(
        "Assert arrays failed",
        _GetSourceLine( (caller)[1,2] ),
        join(', ', map defined($_) ? $_ : '<undef>', @$a),
        join(', ', map defined($_) ? $_ : '<undef>', @$b)
    )
        unless cmparray($a,$b);
}

sub _GetSourceLine {
    my ($file,$line) = @_;
    
    open my $hFile, $file or return "failed to open file: $file: $!";
    
    my $text;
    $text = <$hFile> for ( 1 .. $line);
    chomp $text;
    $text =~ s/^\s+//;
    return "line $line: $text";
}

sub GetCallerSourceLine {
    my $line = shift || 0;    
    return _GetSourceLine( (caller($line + 1))[1,2] )
}

sub run_plan {
    my (@units) = @_;
    
    my $plan = new IMPL::Test::Plan(@units);
    
    $plan->Prepare;
    $plan->AddListener(new IMPL::Test::TAPListener);
    $plan->Run;
}
1;