File Coverage

t/PerlySense-Document-Api-merge.t
Criterion Covered Total %
statement 111 111 100.0
branch 3 4 75.0
condition 3 3 100.0
subroutine 11 11 100.0
pod n/a
total 128 129 99.2


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__