line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
XAO::testcases::base - base class for easier project testing |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 DESCRIPTION |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
This class extends Test::Unit::TestCase with a couple of methods useful |
8
|
|
|
|
|
|
|
for project testing. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=cut |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
############################################################################### |
13
|
|
|
|
|
|
|
package XAO::testcases::base; |
14
|
8
|
|
|
8
|
|
13861
|
use strict; |
|
8
|
|
|
|
|
19
|
|
|
8
|
|
|
|
|
230
|
|
15
|
8
|
|
|
8
|
|
4422
|
use IO::File; |
|
8
|
|
|
|
|
62453
|
|
|
8
|
|
|
|
|
988
|
|
16
|
8
|
|
|
8
|
|
1527
|
use XAO::Utils; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
477
|
|
17
|
8
|
|
|
8
|
|
2772
|
use XAO::Base; |
|
8
|
|
|
|
|
22
|
|
|
8
|
|
|
|
|
313
|
|
18
|
8
|
|
|
8
|
|
2810
|
use XAO::Objects; |
|
8
|
|
|
|
|
20
|
|
|
8
|
|
|
|
|
257
|
|
19
|
8
|
|
|
8
|
|
53
|
use XAO::Projects qw(:all); |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
1029
|
|
20
|
|
|
|
|
|
|
|
21
|
8
|
|
|
8
|
|
138
|
use base qw(Test::Unit::TestCase); |
|
8
|
|
|
|
|
26
|
|
|
8
|
|
|
|
|
7600
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub siteconfig { |
24
|
0
|
|
|
0
|
0
|
0
|
my $self=shift; |
25
|
0
|
|
|
|
|
0
|
return $self->{'siteconfig'}; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub set_up { |
29
|
25
|
|
|
25
|
0
|
23258
|
my $self=shift; |
30
|
|
|
|
|
|
|
|
31
|
25
|
|
|
|
|
72473
|
chomp(my $pwd=`pwd`); |
32
|
|
|
|
|
|
|
|
33
|
25
|
|
|
|
|
451
|
my $root; |
34
|
25
|
|
|
|
|
746
|
foreach my $d ("$pwd/t/xao","$pwd/t/testcases/testroot","$pwd/testcases/testroot") { |
35
|
25
|
50
|
|
|
|
1025
|
if(-d $d) { |
36
|
25
|
|
|
|
|
198
|
$root=$d; |
37
|
25
|
|
|
|
|
122
|
last; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
25
|
|
33
|
|
|
255
|
$root||="$pwd/t/xao"; |
42
|
|
|
|
|
|
|
|
43
|
25
|
|
|
|
|
1086
|
XAO::Base::set_root($root); |
44
|
|
|
|
|
|
|
|
45
|
25
|
|
|
|
|
568
|
push @INC,$root; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub set_up_project { |
49
|
0
|
|
|
0
|
0
|
0
|
my $self=shift; |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
|
|
0
|
my $config=XAO::Objects->new( |
52
|
|
|
|
|
|
|
objname => 'Config', |
53
|
|
|
|
|
|
|
sitename => 'test', |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
0
|
create_project( |
57
|
|
|
|
|
|
|
name => 'test', |
58
|
|
|
|
|
|
|
object => $config, |
59
|
|
|
|
|
|
|
set_current => 1, |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
|
62
|
0
|
|
|
|
|
0
|
$config->init(); |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
0
|
$self->{'siteconfig'}=$config; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub tear_down { |
68
|
25
|
|
|
25
|
0
|
2762
|
my $self=shift; |
69
|
25
|
|
|
|
|
259
|
$self->get_stdout(); |
70
|
25
|
|
|
|
|
189
|
$self->get_stderr(); |
71
|
25
|
|
|
|
|
262
|
drop_project('test'); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub timestamp ($$) { |
75
|
0
|
|
|
0
|
0
|
0
|
my $self=shift; |
76
|
0
|
|
|
|
|
0
|
time; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub timediff ($$$) { |
80
|
0
|
|
|
0
|
0
|
0
|
my $self=shift; |
81
|
0
|
|
|
|
|
0
|
my $t1=shift; |
82
|
0
|
|
|
|
|
0
|
my $t2=shift; |
83
|
0
|
|
|
|
|
0
|
$t1-$t2; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub catch_stdout ($) { |
87
|
1
|
|
|
1
|
0
|
96
|
my $self=shift; |
88
|
|
|
|
|
|
|
$self->assert(!$self->{tempfileout}, |
89
|
1
|
|
|
|
|
40
|
"Already catching STDOUT"); |
90
|
|
|
|
|
|
|
|
91
|
1
|
50
|
|
|
|
63
|
open(TEMPSTDOUT,">&STDOUT") || die; |
92
|
1
|
|
50
|
|
|
60
|
my $tempstdout=IO::File->new_from_fd(fileno(TEMPSTDOUT),"w") || die; |
93
|
1
|
|
|
|
|
237
|
$self->assert($tempstdout, |
94
|
|
|
|
|
|
|
"Can't make a copy of STDOUT"); |
95
|
1
|
|
|
|
|
21
|
$self->{tempstdout}=$tempstdout; |
96
|
|
|
|
|
|
|
|
97
|
1
|
|
|
|
|
220
|
$self->{tempfileout}=IO::File->new_tmpfile(); |
98
|
|
|
|
|
|
|
$self->assert($self->{tempfileout}, |
99
|
1
|
|
|
|
|
7
|
"Can't create temporary file"); |
100
|
|
|
|
|
|
|
|
101
|
1
|
|
|
|
|
33
|
open(STDOUT,'>&' . $self->{tempfileout}->fileno); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub get_stdout ($) { |
105
|
26
|
|
|
26
|
0
|
191
|
my $self=shift; |
106
|
|
|
|
|
|
|
|
107
|
26
|
|
|
|
|
139
|
my $file=$self->{tempfileout}; |
108
|
26
|
100
|
|
|
|
167
|
return undef unless $file; |
109
|
|
|
|
|
|
|
|
110
|
1
|
|
|
|
|
8
|
open(STDOUT,'>&' . $self->{tempstdout}->fileno); |
111
|
1
|
|
|
|
|
45
|
$self->{tempstdout}->close(); |
112
|
|
|
|
|
|
|
|
113
|
1
|
|
|
|
|
30
|
$file->seek(0,0); |
114
|
1
|
|
|
|
|
103
|
my $text=join('',$file->getlines); |
115
|
1
|
|
|
|
|
88
|
$file->close; |
116
|
|
|
|
|
|
|
|
117
|
1
|
|
|
|
|
48
|
delete $self->{tempfileout}; |
118
|
1
|
|
|
|
|
10
|
delete $self->{tempstdout}; |
119
|
|
|
|
|
|
|
|
120
|
1
|
|
|
|
|
9
|
return $text; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub catch_stderr ($) { |
124
|
1
|
|
|
1
|
0
|
28
|
my $self=shift; |
125
|
|
|
|
|
|
|
$self->assert(!$self->{tempstderr}, |
126
|
1
|
|
|
|
|
4
|
"Already catching STDERR"); |
127
|
|
|
|
|
|
|
|
128
|
1
|
50
|
|
|
|
31
|
open(TEMPSTDERR,">&STDERR") || die; |
129
|
1
|
|
50
|
|
|
6
|
my $tempstderr=IO::File->new_from_fd(fileno(TEMPSTDERR),"w") || die; |
130
|
1
|
|
|
|
|
91
|
$self->assert($tempstderr, |
131
|
|
|
|
|
|
|
"Can't make a copy of STDERR"); |
132
|
1
|
|
|
|
|
16
|
$self->{tempstderr}=$tempstderr; |
133
|
|
|
|
|
|
|
|
134
|
1
|
|
|
|
|
103
|
$self->{tempfileerr}=IO::File->new_tmpfile(); |
135
|
|
|
|
|
|
|
$self->assert($self->{tempfileerr}, |
136
|
1
|
|
|
|
|
13
|
"Can't create temporary file"); |
137
|
|
|
|
|
|
|
|
138
|
1
|
|
|
|
|
11
|
open(STDERR,'>&' . $self->{tempfileerr}->fileno); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub get_stderr ($) { |
142
|
26
|
|
|
26
|
0
|
142
|
my $self=shift; |
143
|
|
|
|
|
|
|
|
144
|
26
|
|
|
|
|
62
|
my $file=$self->{tempfileerr}; |
145
|
26
|
100
|
|
|
|
73
|
return undef unless $file; |
146
|
|
|
|
|
|
|
|
147
|
1
|
|
|
|
|
3
|
open(STDERR,'>&' . $self->{tempstderr}->fileno); |
148
|
1
|
|
|
|
|
28
|
$self->{tempstderr}->close(); |
149
|
|
|
|
|
|
|
|
150
|
1
|
|
|
|
|
21
|
$file->seek(0,0); |
151
|
1
|
|
|
|
|
38
|
my $text=join('',$file->getlines); |
152
|
1
|
|
|
|
|
67
|
$file->close; |
153
|
|
|
|
|
|
|
|
154
|
1
|
|
|
|
|
35
|
delete $self->{tempfileerr}; |
155
|
1
|
|
|
|
|
5
|
delete $self->{tempstderr}; |
156
|
|
|
|
|
|
|
|
157
|
1
|
|
|
|
|
4
|
return $text; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
1; |
161
|
|
|
|
|
|
|
__END__ |