annotate lib/IMPL/Test.pm @ 418:3f38dabaf5cc ref20150831

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