Mercurial > pub > Impl
comparison lib/IMPL/Test.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:40:23 +0300 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
406:f23fcb19d3c1 | 407:c6e90e02dd17 |
---|---|
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; |