Mercurial > pub > Impl
annotate Lib/IMPL/Test.pm @ 393:69a1f1508696
minor security refactoring
| author | cin |
|---|---|
| date | Fri, 14 Feb 2014 16:41:12 +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; |