|
407
|
1 package IMPL::Test;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use IMPL::lang qw(equals_s);
|
|
|
6 use IMPL::Const qw(:access);
|
|
|
7 require IMPL::Test::SkipException;
|
|
|
8
|
|
|
9 require Exporter;
|
|
|
10 our @ISA = qw(Exporter);
|
|
|
11 our @EXPORT_OK = qw(&test &shared &failed &cmparray &skip &run_plan &assert &assertarray &GetCallerSourceLine);
|
|
|
12
|
|
|
13 require IMPL::Test::Unit;
|
|
|
14 require IMPL::Test::Plan;
|
|
|
15 require IMPL::Test::TAPListener;
|
|
|
16
|
|
|
17 sub test($$) {
|
|
|
18 my ($name,$code) = @_;
|
|
|
19 my $class = caller;
|
|
|
20
|
|
|
21 $class->set_meta(
|
|
|
22 new IMPL::Test::Unit::TestInfo( $name, $code )
|
|
|
23 );
|
|
|
24 }
|
|
|
25
|
|
|
26 sub shared($) {
|
|
|
27 my ($propInfo) = @_;
|
|
|
28
|
|
|
29 my $class = caller;
|
|
|
30
|
|
|
31 die new IMPL::Exception("Only properties could be declared as shared",$propInfo->name) unless eval {$propInfo->isa('IMPL::Class::PropertyInfo')};
|
|
|
32 die new IMPL::Exception("You can't mark the readonly property as shared",$propInfo->name) unless $propInfo->setter;
|
|
|
33 die new IMPL::Exception("Only public properties could be declared as shared",$propInfo->name) unless $propInfo->access == ACCESS_PUBLIC;
|
|
|
34
|
|
|
35 $class->set_meta(new IMPL::Test::Unit::SharedData($propInfo->name));
|
|
|
36 }
|
|
|
37
|
|
|
38 sub failed($;@) {
|
|
|
39 die new IMPL::Test::FailException(@_);
|
|
|
40 }
|
|
|
41
|
|
|
42 sub assert {
|
|
|
43 my ($condition,@params) = @_;
|
|
|
44
|
|
|
45 die new IMPL::Test::FailException(@params ? @params : ("Assertion failed" , _GetSourceLine( (caller)[1,2] )) ) unless $condition;
|
|
|
46 }
|
|
|
47
|
|
|
48 sub skip($;@) {
|
|
|
49 die new IMPL::Test::SkipException(@_);
|
|
|
50 }
|
|
|
51
|
|
|
52 sub cmparray {
|
|
|
53 my ($a,$b) = @_;
|
|
|
54
|
|
|
55 return 0 unless @$a == @$b;
|
|
|
56
|
|
|
57 for (my $i=0; $i < @$a; $i++ ) {
|
|
|
58 return 0 unless
|
|
|
59 equals_s($a->[$i], $b->[$i]);
|
|
|
60 }
|
|
|
61
|
|
|
62 return 1;
|
|
|
63 }
|
|
|
64
|
|
|
65 sub assertarray {
|
|
|
66 my ($a,$b) = @_;
|
|
|
67
|
|
|
68
|
|
|
69 die IMPL::Test::FailException->new(
|
|
|
70 "Assert arrays failed",
|
|
|
71 _GetSourceLine( (caller)[1,2] ),
|
|
|
72 join(', ', map defined($_) ? $_ : '<undef>', @$a),
|
|
|
73 join(', ', map defined($_) ? $_ : '<undef>', @$b)
|
|
|
74 )
|
|
|
75 unless cmparray($a,$b);
|
|
|
76 }
|
|
|
77
|
|
|
78 sub _GetSourceLine {
|
|
|
79 my ($file,$line) = @_;
|
|
|
80
|
|
|
81 open my $hFile, $file or return "failed to open file: $file: $!";
|
|
|
82
|
|
|
83 my $text;
|
|
|
84 $text = <$hFile> for ( 1 .. $line);
|
|
|
85 chomp $text;
|
|
|
86 $text =~ s/^\s+//;
|
|
|
87 return "line $line: $text";
|
|
|
88 }
|
|
|
89
|
|
|
90 sub GetCallerSourceLine {
|
|
|
91 my $line = shift || 0;
|
|
|
92 return _GetSourceLine( (caller($line + 1))[1,2] )
|
|
|
93 }
|
|
|
94
|
|
|
95 sub run_plan {
|
|
|
96 my (@units) = @_;
|
|
|
97
|
|
|
98 my $plan = new IMPL::Test::Plan(@units);
|
|
|
99
|
|
|
100 $plan->Prepare;
|
|
|
101 $plan->AddListener(new IMPL::Test::TAPListener);
|
|
|
102 $plan->Run;
|
|
|
103 }
|
|
|
104 1;
|
