line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
2
|
1
|
|
|
1
|
|
102402
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
63
|
|
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
481
|
use Test::More tests => 53; |
|
1
|
|
|
|
|
14288
|
|
|
1
|
|
|
|
|
8
|
|
5
|
1
|
|
|
1
|
|
609
|
use Test::Exception; |
|
1
|
|
|
|
|
2544
|
|
|
1
|
|
|
|
|
4
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
601
|
use Data::Dumper; |
|
1
|
|
|
|
|
5235
|
|
|
1
|
|
|
|
|
42
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
261
|
use lib "../lib"; |
|
1
|
|
|
|
|
533
|
|
|
1
|
|
|
|
|
4
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
79616
|
use_ok("Devel::PerlySense::Document::Api"); |
|
1
|
|
|
|
|
439
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6
|
|
12
|
1
|
|
|
1
|
|
278
|
use_ok("Devel::PerlySense::Document"); |
|
1
|
|
|
|
|
75
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
13
|
1
|
|
|
1
|
|
198
|
use_ok("Devel::PerlySense"); |
|
1
|
|
|
|
|
58
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
50
|
|
1
|
|
2183
|
BEGIN { -d "t" and chdir("t"); } |
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
|
|
188
|
my $dirData = "data/project-lib"; |
19
|
1
|
|
|
|
|
3
|
my $fileOrigin = "$dirData/Game/Object/Worm/Bot.pm"; |
20
|
1
|
|
|
|
|
1
|
my $nameModule = "Game::Object::Worm::Bot"; |
21
|
1
|
|
|
|
|
5
|
my $rexFile = qr/Game.Object.Worm.Bot.pm$/; |
22
|
|
|
|
|
|
|
|
23
|
1
|
|
|
|
|
1
|
my $oLocation; |
24
|
1
|
|
|
|
|
2
|
my $oNode; |
25
|
1
|
|
|
|
|
1
|
my $method; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
1
|
|
|
|
|
14
|
print "\n* Class\n"; |
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
5
|
ok(my $oDocument = Devel::PerlySense::Document->new(oPerlySense => Devel::PerlySense->new()), "new ok"); |
31
|
1
|
|
|
|
|
190
|
ok($oDocument->parse(file => $fileOrigin), "Parsed file ok"); |
32
|
|
|
|
|
|
|
|
33
|
1
|
|
|
|
|
307
|
ok(my $oApi = Devel::PerlySense::Document::Api->new(), "new ok"); |
34
|
|
|
|
|
|
|
|
35
|
1
|
|
|
|
|
186
|
$method = "probabilityTurnRandomly"; |
36
|
1
|
|
|
|
|
5
|
ok($oLocation = $oApi->oLocationSetSub(nameSub => $method, oDocument => $oDocument), " oLocationSetSub without node ok"); |
37
|
1
|
|
|
|
|
209
|
like($oLocation->file, $rexFile, " file correct"); |
38
|
1
|
|
|
|
|
212
|
is($oLocation->row, 0, " row correct"); |
39
|
1
|
|
|
|
|
210
|
is($oLocation->col, 0, " row correct"); |
40
|
1
|
|
|
|
|
209
|
is($oLocation->rhProperty->{sub}, $method, " rhProperty->sub correct"); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
1
|
|
|
|
|
186
|
$method = "moveForward"; |
44
|
1
|
|
|
|
|
3
|
ok($oNode = oNodeSub($oDocument, $method), "Got node"); |
45
|
|
|
|
|
|
|
|
46
|
1
|
|
|
|
|
222
|
ok($oLocation = $oApi->oLocationSetSub(nameSub => $method, oDocument => $oDocument, oNode => $oNode), " oLocationSetSub without node ok"); |
47
|
1
|
|
|
|
|
209
|
like($oLocation->file, $rexFile, " file correct"); |
48
|
1
|
|
|
|
|
210
|
is($oLocation->row, 131, " row correct"); |
49
|
1
|
|
|
|
|
212
|
is($oLocation->col, 1, " row correct"); |
50
|
1
|
|
|
|
|
210
|
is($oLocation->rhProperty->{sub}, $method, " rhProperty->sub correct"); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
1
|
|
|
|
|
187
|
is_deeply([ sort keys %{$oApi->rhSub} ], |
|
1
|
|
|
|
|
26
|
|
54
|
|
|
|
|
|
|
[ sort qw( |
55
|
|
|
|
|
|
|
probabilityTurnRandomly |
56
|
|
|
|
|
|
|
moveForward |
57
|
|
|
|
|
|
|
) ], "rhSub contains the ok keys"); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
1
|
|
|
|
|
433
|
print "\n* Base class\n"; |
65
|
1
|
|
|
|
|
3
|
$fileOrigin = "$dirData/Game/Object/Worm.pm"; |
66
|
1
|
|
|
|
|
2
|
$nameModule = "Game::Object::Worm"; |
67
|
1
|
|
|
|
|
5
|
my $rexFileBase = qr/Game.Object.Worm.pm$/; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
|
70
|
1
|
|
|
|
|
8
|
ok(my $oDocumentBase = Devel::PerlySense::Document->new(oPerlySense => Devel::PerlySense->new()), "new ok"); |
71
|
1
|
|
|
|
|
188
|
ok($oDocumentBase->parse(file => $fileOrigin), "Parsed file ok"); |
72
|
|
|
|
|
|
|
|
73
|
1
|
|
|
|
|
322
|
ok(my $oApiBase = Devel::PerlySense::Document::Api->new(), "new ok"); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
1
|
|
|
|
|
184
|
$method = "isRealPlayer"; |
77
|
1
|
|
|
|
|
5
|
ok($oLocation = $oApiBase->oLocationSetSub(nameSub => $method, oDocument => $oDocumentBase), " oLocationSetSub without node ok"); |
78
|
1
|
|
|
|
|
221
|
like($oLocation->file, $rexFileBase, " file correct"); |
79
|
1
|
|
|
|
|
213
|
is($oLocation->row, 0, " row correct"); |
80
|
1
|
|
|
|
|
410
|
is($oLocation->col, 0, " row correct"); |
81
|
1
|
|
|
|
|
226
|
is($oLocation->rhProperty->{sub}, $method, " rhProperty->sub correct"); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
1
|
|
|
|
|
185
|
$method = "moveForward"; |
85
|
1
|
|
|
|
|
3
|
ok($oNode = oNodeSub($oDocumentBase, $method), "Got node"); |
86
|
|
|
|
|
|
|
|
87
|
1
|
|
|
|
|
258
|
ok($oLocation = $oApiBase->oLocationSetSub(nameSub => $method, oDocument => $oDocumentBase, oNode => $oNode), " oLocationSetSub without node ok"); |
88
|
1
|
|
|
|
|
222
|
like($oLocation->file, $rexFileBase, " file correct"); |
89
|
1
|
|
|
|
|
215
|
is($oLocation->row, 186, " row correct"); |
90
|
1
|
|
|
|
|
212
|
is($oLocation->col, 1, " row correct"); |
91
|
1
|
|
|
|
|
210
|
is($oLocation->rhProperty->{sub}, $method, " rhProperty->sub correct"); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
1
|
|
|
|
|
187
|
$method = "turn"; |
96
|
1
|
|
|
|
|
4
|
ok($oNode = oNodeSub($oDocumentBase, $method), "Got node"); |
97
|
|
|
|
|
|
|
|
98
|
1
|
|
|
|
|
489
|
ok($oLocation = $oApiBase->oLocationSetSub(nameSub => $method, oDocument => $oDocumentBase, oNode => $oNode), " oLocationSetSub without node ok"); |
99
|
1
|
|
|
|
|
209
|
like($oLocation->file, $rexFileBase, " file correct"); |
100
|
1
|
|
|
|
|
217
|
is($oLocation->row, 253, " row correct"); |
101
|
1
|
|
|
|
|
222
|
is($oLocation->col, 1, " row correct"); |
102
|
1
|
|
|
|
|
214
|
is($oLocation->rhProperty->{sub}, $method, " rhProperty->sub correct"); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
1
|
|
|
|
|
192
|
is_deeply([ sort keys %{$oApiBase->rhSub} ], |
|
1
|
|
|
|
|
27
|
|
106
|
|
|
|
|
|
|
[ sort qw( |
107
|
|
|
|
|
|
|
isRealPlayer |
108
|
|
|
|
|
|
|
moveForward |
109
|
|
|
|
|
|
|
turn |
110
|
|
|
|
|
|
|
) ], "rhSub contains the ok keys"); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
|
118
|
1
|
|
|
|
|
436
|
print "\n* Merging\n"; |
119
|
|
|
|
|
|
|
|
120
|
1
|
|
|
|
|
4
|
ok($oApi->mergeWithBase($oApiBase), "Merge ok"); |
121
|
|
|
|
|
|
|
|
122
|
1
|
|
|
|
|
187
|
is_deeply([ sort keys %{$oApi->rhSub} ], |
|
1
|
|
|
|
|
27
|
|
123
|
|
|
|
|
|
|
[ sort qw( |
124
|
|
|
|
|
|
|
isRealPlayer |
125
|
|
|
|
|
|
|
moveForward |
126
|
|
|
|
|
|
|
turn |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
probabilityTurnRandomly |
129
|
|
|
|
|
|
|
) ], "rhSub contains the ok keys"); |
130
|
|
|
|
|
|
|
|
131
|
1
|
|
|
|
|
400
|
$method = "isRealPlayer"; |
132
|
1
|
|
|
|
|
26
|
ok($oLocation = $oApi->rhSub->{$method}, "Got method"); |
133
|
1
|
|
|
|
|
215
|
like($oLocation->file, $rexFileBase, " file correct"); |
134
|
1
|
|
|
|
|
214
|
is($oLocation->row, 0, " row correct"); |
135
|
|
|
|
|
|
|
|
136
|
1
|
|
|
|
|
188
|
$method = "moveForward"; |
137
|
1
|
|
|
|
|
26
|
ok($oLocation = $oApi->rhSub->{$method}, "Got method"); |
138
|
1
|
|
|
|
|
215
|
like($oLocation->file, $rexFile, " file correct"); |
139
|
1
|
|
|
|
|
541
|
is($oLocation->row, 131, " row correct"); |
140
|
|
|
|
|
|
|
|
141
|
1
|
|
|
|
|
192
|
$method = "turn"; |
142
|
1
|
|
|
|
|
28
|
ok($oLocation = $oApi->rhSub->{$method}, "Got method"); |
143
|
1
|
|
|
|
|
218
|
like($oLocation->file, $rexFileBase, " file correct"); |
144
|
1
|
|
|
|
|
212
|
is($oLocation->row, 253, " row correct"); |
145
|
|
|
|
|
|
|
|
146
|
1
|
|
|
|
|
187
|
$method = "probabilityTurnRandomly"; |
147
|
1
|
|
|
|
|
27
|
ok($oLocation = $oApi->rhSub->{$method}, "Got method"); |
148
|
1
|
|
|
|
|
213
|
like($oLocation->file, $rexFile, " file correct"); |
149
|
1
|
|
|
|
|
211
|
is($oLocation->row, 0, " row correct"); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub oNodeSub { |
158
|
3
|
|
|
3
|
|
5
|
my ($oDocument, $name) = @_; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
$oDocument->oDocument->find_first( |
161
|
|
|
|
|
|
|
sub { |
162
|
2123
|
|
|
2123
|
|
13509
|
my ($oTop, $oNode) = @_; |
163
|
2123
|
100
|
100
|
|
|
6740
|
$oNode->isa("PPI::Statement::Sub") && $oNode->name eq $name and return(1); |
164
|
2120
|
|
|
|
|
3154
|
return(0); |
165
|
3
|
|
|
|
|
80
|
}); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
__END__ |