Mercurial > pub > Impl
comparison Lib/IMPL/Test.pm @ 285:546957c50a36
*IMPL::Web::Handler::TTView Reworked template selection mechanism
*IMPL::Web::Application: refactoring
-Removed obsolete IMPL::Text modules
author | cin |
---|---|
date | Mon, 18 Feb 2013 02:55:59 +0400 |
parents | 4ddb27ff4a0b |
children |
comparison
equal
deleted
inserted
replaced
284:f2a6bc5f3184 | 285:546957c50a36 |
---|---|
1 package IMPL::Test; | 1 package IMPL::Test; |
2 use strict; | 2 use strict; |
3 use warnings; | 3 use warnings; |
4 | 4 |
5 use IMPL::lang qw(equals_s); | |
5 use IMPL::Const qw(:access); | 6 use IMPL::Const qw(:access); |
6 require IMPL::Test::SkipException; | 7 require IMPL::Test::SkipException; |
7 | 8 |
8 require Exporter; | 9 require Exporter; |
9 our @ISA = qw(Exporter); | 10 our @ISA = qw(Exporter); |
10 our @EXPORT_OK = qw(&test &shared &failed &cmparray &skip &run_plan &assert &GetCallerSourceLine); | 11 our @EXPORT_OK = qw(&test &shared &failed &cmparray &skip &run_plan &assert &assertarray &GetCallerSourceLine); |
11 | 12 |
12 require IMPL::Test::Unit; | 13 require IMPL::Test::Unit; |
13 require IMPL::Test::Plan; | 14 require IMPL::Test::Plan; |
14 require IMPL::Test::TAPListener; | 15 require IMPL::Test::TAPListener; |
15 | 16 |
52 my ($a,$b) = @_; | 53 my ($a,$b) = @_; |
53 | 54 |
54 return 0 unless @$a == @$b; | 55 return 0 unless @$a == @$b; |
55 | 56 |
56 for (my $i=0; $i < @$a; $i++ ) { | 57 for (my $i=0; $i < @$a; $i++ ) { |
57 return 0 unless $a->[$i] eq $b->[$i]; | 58 return 0 unless |
59 equals_s($a->[$i], $b->[$i]); | |
58 } | 60 } |
59 | 61 |
60 return 1; | 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); | |
61 } | 76 } |
62 | 77 |
63 sub _GetSourceLine { | 78 sub _GetSourceLine { |
64 my ($file,$line) = @_; | 79 my ($file,$line) = @_; |
65 | 80 |