Mercurial > pub > Impl
annotate Lib/IMPL/Test.pm @ 306:d4caf951260d
missing files
author | cin |
---|---|
date | Wed, 17 Apr 2013 19:33:07 +0400 |
parents | 546957c50a36 |
children |
rev | line source |
---|---|
49 | 1 package IMPL::Test; |
2 use strict; | |
3 use warnings; | |
4 | |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
5 use IMPL::lang qw(equals_s); |
278 | 6 use IMPL::Const qw(:access); |
84 | 7 require IMPL::Test::SkipException; |
8 | |
49 | 9 require Exporter; |
10 our @ISA = qw(Exporter); | |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
11 our @EXPORT_OK = qw(&test &shared &failed &cmparray &skip &run_plan &assert &assertarray &GetCallerSourceLine); |
49 | 12 |
13 require IMPL::Test::Unit; | |
159 | 14 require IMPL::Test::Plan; |
15 require IMPL::Test::TAPListener; | |
49 | 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 | |
275 | 31 die new IMPL::Exception("Only properties could be declared as shared",$propInfo->name) unless eval {$propInfo->isa('IMPL::Class::PropertyInfo')}; |
278 | 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; | |
49 | 34 |
275 | 35 $class->set_meta(new IMPL::Test::Unit::SharedData($propInfo->name)); |
49 | 36 } |
37 | |
38 sub failed($;@) { | |
39 die new IMPL::Test::FailException(@_); | |
40 } | |
41 | |
165 | 42 sub assert { |
194 | 43 my ($condition,@params) = @_; |
44 | |
45 die new IMPL::Test::FailException(@params ? @params : ("Assertion failed" , _GetSourceLine( (caller)[1,2] )) ) unless $condition; | |
165 | 46 } |
47 | |
84 | 48 sub skip($;@) { |
194 | 49 die new IMPL::Test::SkipException(@_); |
84 | 50 } |
51 | |
49 | 52 sub cmparray { |
53 my ($a,$b) = @_; | |
54 | |
55 return 0 unless @$a == @$b; | |
56 | |
57 for (my $i=0; $i < @$a; $i++ ) { | |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
58 return 0 unless |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
59 equals_s($a->[$i], $b->[$i]); |
49 | 60 } |
61 | |
62 return 1; | |
63 } | |
159 | 64 |
285
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
65 sub assertarray { |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
66 my ($a,$b) = @_; |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
67 |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
68 |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
69 die IMPL::Test::FailException->new( |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
70 "Assert arrays failed", |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
71 _GetSourceLine( (caller)[1,2] ), |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
72 join(', ', map defined($_) ? $_ : '<undef>', @$a), |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
73 join(', ', map defined($_) ? $_ : '<undef>', @$b) |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
74 ) |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
75 unless cmparray($a,$b); |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
76 } |
546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
cin
parents:
278
diff
changeset
|
77 |
165 | 78 sub _GetSourceLine { |
194 | 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"; | |
165 | 88 } |
89 | |
188 | 90 sub GetCallerSourceLine { |
194 | 91 my $line = shift || 0; |
92 return _GetSourceLine( (caller($line + 1))[1,2] ) | |
188 | 93 } |
94 | |
159 | 95 sub run_plan { |
194 | 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; | |
159 | 103 } |
49 | 104 1; |