line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Weaken; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
# maybe: |
5
|
|
|
|
|
|
|
# contents_funcs => arrayref of funcs |
6
|
|
|
|
|
|
|
# multiple contents, or sub{} returning list enough ? |
7
|
|
|
|
|
|
|
# track_filehandles => 1 GLOB and IO |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# locations=>1 |
10
|
|
|
|
|
|
|
# top->{'foo'}->[10]->REF->*{IO} |
11
|
|
|
|
|
|
|
# top.H{'foo'}.A[10].REF.*{IO} |
12
|
|
|
|
|
|
|
# unfreed_locations() arrayref of strings |
13
|
|
|
|
|
|
|
# first location encountered |
14
|
|
|
|
|
|
|
# locations_maxdepth |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
18
|
|
|
18
|
|
721040
|
use 5.006; |
|
18
|
|
|
|
|
77
|
|
|
18
|
|
|
|
|
899
|
|
18
|
18
|
|
|
18
|
|
104
|
use strict; |
|
18
|
|
|
|
|
34
|
|
|
18
|
|
|
|
|
738
|
|
19
|
18
|
|
|
18
|
|
101
|
use warnings; |
|
18
|
|
|
|
|
51
|
|
|
18
|
|
|
|
|
1931
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
require Exporter; |
22
|
|
|
|
|
|
|
|
23
|
18
|
|
|
18
|
|
100
|
use base qw(Exporter); |
|
18
|
|
|
|
|
33
|
|
|
18
|
|
|
|
|
3512
|
|
24
|
|
|
|
|
|
|
our @EXPORT_OK = qw(leaks poof); |
25
|
|
|
|
|
|
|
our $VERSION = '3.022000'; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
#use Smart::Comments; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
### Using Smart Comments ... |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=begin Implementation: |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
The basic strategy: get a list of all the objects which allocate memory, |
34
|
|
|
|
|
|
|
create probe references to them, weaken those probe references, attempt |
35
|
|
|
|
|
|
|
to free the memory, and check the references. If the memory is free, |
36
|
|
|
|
|
|
|
the probe references will be undefined. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Probe references also serve a second purpose -- to avoid copying any |
39
|
|
|
|
|
|
|
weak reference in the original object. When you copy a weak reference, |
40
|
|
|
|
|
|
|
the result is a strong reference. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
There may be good reasons for Perl strengthen-on-copy policy, but that |
43
|
|
|
|
|
|
|
behavior is a big problem for this module. A lot of what might seem |
44
|
|
|
|
|
|
|
like needless indirection in the code below is done to avoid working |
45
|
|
|
|
|
|
|
with references directly in situations which could involve making a copy |
46
|
|
|
|
|
|
|
of them, even implicitly. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=end Implementation: |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=cut |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
package Test::Weaken::Internal; |
53
|
|
|
|
|
|
|
|
54
|
18
|
|
|
18
|
|
31465
|
use English qw( -no_match_vars ); |
|
18
|
|
|
|
|
104815
|
|
|
18
|
|
|
|
|
125
|
|
55
|
18
|
|
|
18
|
|
10684
|
use Carp; |
|
18
|
|
|
|
|
36
|
|
|
18
|
|
|
|
|
1582
|
|
56
|
18
|
|
|
18
|
|
101
|
use Scalar::Util 1.18 qw(); |
|
18
|
|
|
|
|
818
|
|
|
18
|
|
|
|
|
84771
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my @default_tracked_types = qw(REF SCALAR VSTRING HASH ARRAY CODE); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub follow { |
61
|
90
|
|
|
90
|
|
181
|
my ( $self, @base_probe_list ) = @_; |
62
|
|
|
|
|
|
|
|
63
|
90
|
|
|
|
|
146
|
my $ignore_preds = $self->{ignore_preds}; |
64
|
90
|
|
|
|
|
189
|
my $contents = $self->{contents}; |
65
|
90
|
|
|
|
|
124
|
my $trace_maxdepth = $self->{trace_maxdepth}; |
66
|
90
|
|
|
|
|
129
|
my $trace_following = $self->{trace_following}; |
67
|
90
|
|
|
|
|
180
|
my $trace_tracking = $self->{trace_tracking}; |
68
|
90
|
|
|
|
|
321
|
my $user_tracked_types = $self->{tracked_types}; |
69
|
|
|
|
|
|
|
|
70
|
90
|
|
|
|
|
302
|
my @tracked_types = @default_tracked_types; |
71
|
90
|
100
|
|
|
|
276
|
if ( defined $user_tracked_types ) { |
72
|
5
|
|
|
|
|
6
|
push @tracked_types, @{$user_tracked_types}; |
|
5
|
|
|
|
|
12
|
|
73
|
|
|
|
|
|
|
} |
74
|
90
|
|
|
|
|
188
|
my %tracked_type = map { ( $_, 1 ) } @tracked_types; |
|
547
|
|
|
|
|
5919
|
|
75
|
|
|
|
|
|
|
|
76
|
90
|
50
|
|
|
|
293
|
defined $trace_maxdepth or $trace_maxdepth = 0; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Initialize the results with a reference to the dereferenced |
79
|
|
|
|
|
|
|
# base reference. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# The initialization assumes each $base_probe is a reference, |
82
|
|
|
|
|
|
|
# not part of the test object, whose referent is also a reference |
83
|
|
|
|
|
|
|
# which IS part of the test object. |
84
|
90
|
|
|
|
|
154
|
my @follow_probes = @base_probe_list; |
85
|
90
|
|
|
|
|
174
|
my @tracking_probes = @base_probe_list; |
86
|
90
|
|
|
|
|
130
|
my %already_followed = (); |
87
|
90
|
|
|
|
|
126
|
my %already_tracked = (); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
FOLLOW_OBJECT: |
90
|
90
|
|
|
|
|
266
|
while ( defined( my $follow_probe = pop @follow_probes ) ) { |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# The follow probes are to objects which either will not be |
93
|
|
|
|
|
|
|
# tracked or which have already been added to @tracking_probes |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
next FOLLOW_OBJECT |
96
|
684
|
100
|
|
|
|
2533
|
if $already_followed{ Scalar::Util::refaddr $follow_probe }++; |
97
|
|
|
|
|
|
|
|
98
|
636
|
|
|
|
|
5818
|
my $object_type = Scalar::Util::reftype $follow_probe; |
99
|
|
|
|
|
|
|
|
100
|
636
|
|
|
|
|
824
|
my @child_probes = (); |
101
|
|
|
|
|
|
|
|
102
|
636
|
50
|
|
|
|
1111
|
if ($trace_following) { |
103
|
0
|
|
|
|
|
0
|
require Data::Dumper; |
104
|
|
|
|
|
|
|
## no critic (ValuesAndExpressions::ProhibitLongChainsOfMethodCalls) |
105
|
0
|
0
|
|
|
|
0
|
print {*STDERR} 'Following: ', |
|
0
|
|
|
|
|
0
|
|
106
|
|
|
|
|
|
|
Data::Dumper->new( [$follow_probe], [qw(tracking)] )->Terse(1) |
107
|
|
|
|
|
|
|
->Maxdepth($trace_maxdepth)->Dump |
108
|
|
|
|
|
|
|
or Carp::croak("Cannot print to STDOUT: $ERRNO"); |
109
|
|
|
|
|
|
|
## use critic |
110
|
|
|
|
|
|
|
} ## end if ($trace_following) |
111
|
|
|
|
|
|
|
|
112
|
636
|
100
|
|
|
|
1258
|
if ( defined $contents ) { |
113
|
50
|
|
|
|
|
57
|
my $safe_copy = $follow_probe; |
114
|
50
|
|
|
|
|
109
|
push @child_probes, map { \$_ } ( $contents->($safe_copy) ); |
|
8
|
|
|
|
|
96
|
|
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
FIND_CHILDREN: { |
118
|
|
|
|
|
|
|
|
119
|
636
|
|
|
|
|
800
|
foreach my $ignore (@$ignore_preds) { |
|
636
|
|
|
|
|
1266
|
|
120
|
232
|
|
|
|
|
270
|
my $safe_copy = $follow_probe; |
121
|
232
|
100
|
|
|
|
386
|
last FIND_CHILDREN if $ignore->($safe_copy); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
612
|
100
|
|
|
|
1567
|
if ( $object_type eq 'ARRAY' ) { |
125
|
83
|
100
|
|
|
|
107
|
if ( my $tied_var = tied @{$follow_probe} ) { |
|
83
|
|
|
|
|
251
|
|
126
|
1
|
|
|
|
|
3
|
push @child_probes, \($tied_var); |
127
|
|
|
|
|
|
|
} |
128
|
83
|
|
|
|
|
111
|
foreach my $i ( 0 .. $#{$follow_probe} ) { |
|
83
|
|
|
|
|
225
|
|
129
|
149
|
100
|
|
|
|
334
|
if ( exists $follow_probe->[$i] ) { |
130
|
144
|
|
|
|
|
313
|
push @child_probes, \( $follow_probe->[$i] ); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
83
|
|
|
|
|
161
|
last FIND_CHILDREN; |
134
|
|
|
|
|
|
|
} ## end if ( $object_type eq 'ARRAY' ) |
135
|
|
|
|
|
|
|
|
136
|
529
|
100
|
|
|
|
1083
|
if ( $object_type eq 'HASH' ) { |
137
|
79
|
100
|
|
|
|
90
|
if ( my $tied_var = tied %{$follow_probe} ) { |
|
79
|
|
|
|
|
232
|
|
138
|
1
|
|
|
|
|
2
|
push @child_probes, \($tied_var); |
139
|
|
|
|
|
|
|
} |
140
|
79
|
|
|
|
|
112
|
push @child_probes, map { \$_ } values %{$follow_probe}; |
|
122
|
|
|
|
|
347
|
|
|
79
|
|
|
|
|
184
|
|
141
|
79
|
|
|
|
|
142
|
last FIND_CHILDREN; |
142
|
|
|
|
|
|
|
} ## end if ( $object_type eq 'HASH' ) |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# GLOB is not tracked by default, |
145
|
|
|
|
|
|
|
# but we follow ties |
146
|
450
|
100
|
|
|
|
927
|
if ( $object_type eq 'GLOB' ) { |
147
|
7
|
100
|
|
|
|
11
|
if ( my $tied_var = tied *${$follow_probe} ) { |
|
7
|
|
|
|
|
33
|
|
148
|
1
|
|
|
|
|
2
|
push @child_probes, \($tied_var); |
149
|
|
|
|
|
|
|
} |
150
|
7
|
|
|
|
|
14
|
last FIND_CHILDREN; |
151
|
|
|
|
|
|
|
} ## end if ( $object_type eq 'GLOB' ) |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# LVALUE is not tracked by default, |
154
|
|
|
|
|
|
|
# but we follow ties |
155
|
443
|
50
|
66
|
|
|
3170
|
if ( $object_type eq 'SCALAR' |
|
|
|
66
|
|
|
|
|
156
|
|
|
|
|
|
|
or $object_type eq 'VSTRING' |
157
|
|
|
|
|
|
|
or $object_type eq 'LVALUE' ) |
158
|
|
|
|
|
|
|
{ |
159
|
144
|
100
|
|
|
|
168
|
if ( my $tied_var = tied ${$follow_probe} ) { |
|
144
|
|
|
|
|
426
|
|
160
|
1
|
|
|
|
|
2
|
push @child_probes, \($tied_var); |
161
|
|
|
|
|
|
|
} |
162
|
144
|
|
|
|
|
219
|
last FIND_CHILDREN; |
163
|
|
|
|
|
|
|
} ## end if ( $object_type eq 'SCALAR' or $object_type eq ...) |
164
|
|
|
|
|
|
|
|
165
|
299
|
100
|
|
|
|
630
|
if ( $object_type eq 'REF' ) { |
166
|
297
|
50
|
|
|
|
308
|
if ( my $tied_var = tied ${$follow_probe} ) { |
|
297
|
|
|
|
|
770
|
|
167
|
0
|
|
|
|
|
0
|
push @child_probes, \($tied_var); |
168
|
|
|
|
|
|
|
} |
169
|
297
|
|
|
|
|
363
|
push @child_probes, ${$follow_probe}; |
|
297
|
|
|
|
|
445
|
|
170
|
297
|
|
|
|
|
531
|
last FIND_CHILDREN; |
171
|
|
|
|
|
|
|
} ## end if ( $object_type eq 'REF' ) |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
} ## end FIND_CHILDREN: |
174
|
|
|
|
|
|
|
|
175
|
634
|
|
|
|
|
810
|
push @follow_probes, @child_probes; |
176
|
|
|
|
|
|
|
|
177
|
634
|
|
|
|
|
1524
|
CHILD_PROBE: for my $child_probe (@child_probes) { |
178
|
|
|
|
|
|
|
|
179
|
575
|
|
|
|
|
1170
|
my $child_type = Scalar::Util::reftype $child_probe; |
180
|
|
|
|
|
|
|
|
181
|
575
|
100
|
|
|
|
2301
|
next CHILD_PROBE unless $tracked_type{$child_type}; |
182
|
|
|
|
|
|
|
|
183
|
573
|
|
|
|
|
628
|
my $new_tracking_probe = $child_probe; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
next CHILD_PROBE |
186
|
573
|
100
|
|
|
|
2242
|
if $already_tracked{ Scalar::Util::refaddr $new_tracking_probe |
187
|
|
|
|
|
|
|
}++; |
188
|
|
|
|
|
|
|
|
189
|
525
|
|
|
|
|
842
|
foreach my $ignore (@$ignore_preds) { |
190
|
178
|
|
|
|
|
186
|
my $safe_copy = $new_tracking_probe; |
191
|
178
|
100
|
|
|
|
305
|
next CHILD_PROBE if $ignore->($safe_copy); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
501
|
50
|
|
|
|
1428
|
if ($trace_tracking) { |
195
|
|
|
|
|
|
|
## no critic (ValuesAndExpressions::ProhibitLongChainsOfMethodCalls) |
196
|
0
|
0
|
|
|
|
0
|
print {*STDERR} 'Tracking: ', |
|
0
|
|
|
|
|
0
|
|
197
|
|
|
|
|
|
|
Data::Dumper->new( [$new_tracking_probe], [qw(tracking)] ) |
198
|
|
|
|
|
|
|
->Terse(1)->Maxdepth($trace_maxdepth)->Dump |
199
|
|
|
|
|
|
|
or Carp::croak("Cannot print to STDOUT: $ERRNO"); |
200
|
|
|
|
|
|
|
## use critic |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# print {*STDERR} 'Tracking: ', |
203
|
|
|
|
|
|
|
# "$new_tracking_probe\n"; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
} ## end if ($trace_tracking) |
206
|
501
|
|
|
|
|
1966
|
push @tracking_probes, $new_tracking_probe; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
} ## end for my $child_probe (@child_probes) |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
} # FOLLOW_OBJECT |
211
|
|
|
|
|
|
|
|
212
|
86
|
|
|
|
|
681
|
return \@tracking_probes; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
} # sub follow |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# See POD, below |
217
|
|
|
|
|
|
|
sub Test::Weaken::new { |
218
|
90
|
|
|
90
|
1
|
2569
|
my ( $class, $arg1, $arg2 ) = @_; |
219
|
90
|
|
|
|
|
169
|
my $self = {}; |
220
|
90
|
|
|
|
|
224
|
bless $self, $class; |
221
|
90
|
|
|
|
|
317
|
$self->{test} = 1; |
222
|
|
|
|
|
|
|
|
223
|
90
|
|
|
|
|
117
|
my @ignore_preds; |
224
|
|
|
|
|
|
|
my @ignore_classes; |
225
|
0
|
|
|
|
|
0
|
my @ignore_objects; |
226
|
90
|
|
|
|
|
244
|
$self->{ignore_preds} = \@ignore_preds; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
UNPACK_ARGS: { |
229
|
90
|
100
|
|
|
|
138
|
if ( ref $arg1 eq 'CODE' ) { |
|
90
|
|
|
|
|
311
|
|
230
|
36
|
|
|
|
|
94
|
$self->{constructor} = $arg1; |
231
|
36
|
100
|
|
|
|
115
|
if ( defined $arg2 ) { |
232
|
7
|
|
|
|
|
14
|
$self->{destructor} = $arg2; |
233
|
|
|
|
|
|
|
} |
234
|
36
|
|
|
|
|
115
|
return $self; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
54
|
50
|
|
|
|
161
|
if ( ref $arg1 ne 'HASH' ) { |
238
|
0
|
|
|
|
|
0
|
Carp::croak('arg to Test::Weaken::new is not HASH ref'); |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
54
|
50
|
|
|
|
272
|
if (defined (my $constructor = delete $arg1->{constructor})) { |
242
|
54
|
|
|
|
|
116
|
$self->{constructor} = $constructor; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
54
|
100
|
|
|
|
197
|
if (defined (my $destructor = delete $arg1->{destructor})) { |
246
|
6
|
|
|
|
|
22
|
$self->{destructor} = $destructor; |
247
|
|
|
|
|
|
|
} |
248
|
54
|
100
|
|
|
|
157
|
if (defined (my $destructor_method = delete $arg1->{destructor_method})) { |
249
|
2
|
|
|
|
|
4
|
$self->{destructor_method} = $destructor_method; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
54
|
100
|
|
|
|
163
|
if (defined (my $coderef = delete $arg1->{ignore})) { |
253
|
25
|
50
|
|
|
|
65
|
if (ref $coderef ne 'CODE') { |
254
|
0
|
|
|
|
|
0
|
Carp::croak('Test::Weaken: ignore must be CODE ref'); |
255
|
|
|
|
|
|
|
} |
256
|
25
|
|
|
|
|
47
|
push @ignore_preds, $coderef; |
257
|
|
|
|
|
|
|
} |
258
|
54
|
100
|
|
|
|
151
|
if (defined (my $ignore_preds = delete $arg1->{ignore_preds})) { |
259
|
3
|
|
|
|
|
6
|
push @ignore_preds, @$ignore_preds; |
260
|
|
|
|
|
|
|
} |
261
|
54
|
100
|
|
|
|
149
|
if ( defined (my $ignore_class = delete $arg1->{ignore_class} )) { |
262
|
3
|
|
|
|
|
4
|
push @ignore_classes, $ignore_class; |
263
|
|
|
|
|
|
|
} |
264
|
54
|
100
|
|
|
|
275
|
if ( defined (my $ignore_classes = delete $arg1->{ignore_classes} )) { |
265
|
2
|
|
|
|
|
4
|
push @ignore_classes, @$ignore_classes; |
266
|
|
|
|
|
|
|
} |
267
|
54
|
|
|
|
|
275
|
push @ignore_objects, delete $arg1->{ignore_object}; |
268
|
54
|
100
|
|
|
|
348
|
if ( defined (my $ignore_objects = delete $arg1->{ignore_objects} )) { |
269
|
3
|
|
|
|
|
6
|
push @ignore_objects, @$ignore_objects; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
54
|
50
|
|
|
|
137
|
if ( defined $arg1->{trace_maxdepth} ) { |
273
|
0
|
|
|
|
|
0
|
$self->{trace_maxdepth} = $arg1->{trace_maxdepth}; |
274
|
0
|
|
|
|
|
0
|
delete $arg1->{trace_maxdepth}; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
54
|
50
|
|
|
|
159
|
if ( defined $arg1->{trace_following} ) { |
278
|
0
|
|
|
|
|
0
|
$self->{trace_following} = $arg1->{trace_following}; |
279
|
0
|
|
|
|
|
0
|
delete $arg1->{trace_following}; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
54
|
50
|
|
|
|
167
|
if ( defined $arg1->{trace_tracking} ) { |
283
|
0
|
|
|
|
|
0
|
$self->{trace_tracking} = $arg1->{trace_tracking}; |
284
|
0
|
|
|
|
|
0
|
delete $arg1->{trace_tracking}; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
54
|
100
|
|
|
|
210
|
if ( defined $arg1->{contents} ) { |
288
|
6
|
|
|
|
|
22
|
$self->{contents} = $arg1->{contents}; |
289
|
6
|
|
|
|
|
11
|
delete $arg1->{contents}; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
54
|
50
|
|
|
|
219
|
if ( defined $arg1->{test} ) { |
293
|
0
|
|
|
|
|
0
|
$self->{test} = $arg1->{test}; |
294
|
0
|
|
|
|
|
0
|
delete $arg1->{test}; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
54
|
100
|
|
|
|
128
|
if ( defined $arg1->{tracked_types} ) { |
298
|
5
|
|
|
|
|
12
|
$self->{tracked_types} = $arg1->{tracked_types}; |
299
|
5
|
|
|
|
|
9
|
delete $arg1->{tracked_types}; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
54
|
|
|
|
|
63
|
my @unknown_named_args = keys %{$arg1}; |
|
54
|
|
|
|
|
161
|
|
303
|
|
|
|
|
|
|
|
304
|
54
|
50
|
|
|
|
188
|
if (@unknown_named_args) { |
305
|
0
|
|
|
|
|
0
|
my $message = q{}; |
306
|
0
|
|
|
|
|
0
|
for my $unknown_named_arg (@unknown_named_args) { |
307
|
0
|
|
|
|
|
0
|
$message .= "Unknown named arg: '$unknown_named_arg'\n"; |
308
|
|
|
|
|
|
|
} |
309
|
0
|
|
|
|
|
0
|
Carp::croak( $message |
310
|
|
|
|
|
|
|
. 'Test::Weaken failed due to unknown named arg(s)' ); |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
} # UNPACK_ARGS |
314
|
|
|
|
|
|
|
|
315
|
54
|
50
|
|
|
|
291
|
if ( my $ref_type = ref $self->{constructor} ) { |
316
|
54
|
50
|
|
|
|
225
|
Carp::croak('Test::Weaken: constructor must be CODE ref') |
317
|
|
|
|
|
|
|
unless ref $self->{constructor} eq 'CODE'; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
54
|
100
|
|
|
|
159
|
if ( my $ref_type = ref $self->{destructor} ) { |
321
|
6
|
50
|
|
|
|
33
|
Carp::croak('Test::Weaken: destructor must be CODE ref') |
322
|
|
|
|
|
|
|
unless ref $self->{destructor} eq 'CODE'; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
54
|
100
|
|
|
|
158
|
if ( my $ref_type = ref $self->{contents} ) { |
326
|
6
|
50
|
|
|
|
23
|
Carp::croak('Test::Weaken: contents must be CODE ref') |
327
|
|
|
|
|
|
|
unless ref $self->{contents} eq 'CODE'; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
54
|
100
|
|
|
|
140
|
if ( my $ref_type = ref $self->{tracked_types} ) { |
331
|
5
|
50
|
|
|
|
17
|
Carp::croak('Test::Weaken: tracked_types must be ARRAY ref') |
332
|
|
|
|
|
|
|
unless ref $self->{tracked_types} eq 'ARRAY'; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
54
|
100
|
|
|
|
127
|
if (@ignore_classes) { |
336
|
|
|
|
|
|
|
push @ignore_preds, sub { |
337
|
30
|
|
|
30
|
|
33
|
my ($ref) = @_; |
338
|
30
|
100
|
|
|
|
75
|
if (Scalar::Util::blessed($ref)) { |
339
|
20
|
|
|
|
|
24
|
foreach my $class (@ignore_classes) { |
340
|
28
|
100
|
|
|
|
147
|
if ($ref->isa($class)) { |
341
|
12
|
|
|
|
|
52
|
return 1; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
} |
345
|
18
|
|
|
|
|
60
|
return 0; |
346
|
4
|
|
|
|
|
16
|
}; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# undefs in ignore objects are skipped |
350
|
54
|
|
|
|
|
105
|
@ignore_objects = grep {defined} @ignore_objects; |
|
59
|
|
|
|
|
182
|
|
351
|
54
|
100
|
|
|
|
116
|
if (@ignore_objects) { |
352
|
|
|
|
|
|
|
push @ignore_preds, sub { |
353
|
30
|
|
|
30
|
|
34
|
my ($ref) = @_; |
354
|
30
|
|
|
|
|
46
|
$ref = Scalar::Util::refaddr($ref); |
355
|
30
|
|
|
|
|
31
|
foreach my $object (@ignore_objects) { |
356
|
44
|
100
|
|
|
|
112
|
if (Scalar::Util::refaddr($object) == $ref) { |
357
|
12
|
|
|
|
|
52
|
return 1; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
} |
360
|
18
|
|
|
|
|
54
|
return 0; |
361
|
4
|
|
|
|
|
13
|
}; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
54
|
|
|
|
|
155
|
return $self; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
} # sub new |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub Test::Weaken::test { |
369
|
|
|
|
|
|
|
|
370
|
90
|
|
|
90
|
1
|
206
|
my $self = shift; |
371
|
|
|
|
|
|
|
|
372
|
90
|
50
|
|
|
|
290
|
if ( defined $self->{unfreed_probes} ) { |
373
|
0
|
|
|
|
|
0
|
Carp::croak('Test::Weaken tester was already evaluated'); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
90
|
|
|
|
|
141
|
my $constructor = $self->{constructor}; |
377
|
90
|
|
|
|
|
147
|
my $destructor = $self->{destructor}; |
378
|
|
|
|
|
|
|
# my $ignore = $self->{ignore}; |
379
|
90
|
|
|
|
|
136
|
my $contents = $self->{contents}; |
380
|
90
|
|
|
|
|
247
|
my $test = $self->{test}; |
381
|
|
|
|
|
|
|
|
382
|
90
|
|
|
|
|
258
|
my @test_object_probe_list = map {\$_} $constructor->(); |
|
112
|
|
|
|
|
4512
|
|
383
|
90
|
|
|
|
|
191
|
foreach my $test_object_probe (@test_object_probe_list) { |
384
|
112
|
50
|
|
|
|
133
|
if ( not ref ${$test_object_probe} ) { |
|
112
|
|
|
|
|
602
|
|
385
|
0
|
|
|
|
|
0
|
Carp::carp( |
386
|
|
|
|
|
|
|
'Test::Weaken test object constructor returned a non-reference' |
387
|
|
|
|
|
|
|
); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
} |
390
|
90
|
|
|
|
|
265
|
my $probes = Test::Weaken::Internal::follow( $self, @test_object_probe_list ); |
391
|
|
|
|
|
|
|
|
392
|
86
|
|
|
|
|
141
|
$self->{probe_count} = @{$probes}; |
|
86
|
|
|
|
|
228
|
|
393
|
293
|
|
|
|
|
1124
|
$self->{weak_probe_count} = |
394
|
86
|
100
|
|
|
|
126
|
grep { ref $_ eq 'REF' and Scalar::Util::isweak ${$_} } @{$probes}; |
|
605
|
|
|
|
|
1853
|
|
|
86
|
|
|
|
|
148
|
|
395
|
86
|
|
|
|
|
238
|
$self->{strong_probe_count} = |
396
|
|
|
|
|
|
|
$self->{probe_count} - $self->{weak_probe_count}; |
397
|
|
|
|
|
|
|
|
398
|
86
|
50
|
|
|
|
219
|
if ( not $test ) { |
399
|
0
|
|
|
|
|
0
|
$self->{unfreed_probes} = $probes; |
400
|
0
|
|
|
|
|
0
|
return scalar @{$probes}; |
|
0
|
|
|
|
|
0
|
|
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
86
|
|
|
|
|
113
|
for my $probe ( @{$probes} ) { |
|
86
|
|
|
|
|
174
|
|
404
|
605
|
|
|
|
|
1351
|
Scalar::Util::weaken($probe); |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# Now free everything. |
408
|
86
|
100
|
|
|
|
296
|
if (defined (my $destructor_method = $self->{destructor_method})) { |
409
|
2
|
|
|
|
|
3
|
foreach my $test_object_probe (@test_object_probe_list) { |
410
|
4
|
|
|
|
|
1022
|
my $obj = $$test_object_probe; |
411
|
4
|
|
|
|
|
11
|
$obj->$destructor_method; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
} |
414
|
86
|
100
|
|
|
|
1186
|
if (defined $destructor) { |
415
|
13
|
|
|
|
|
27
|
$destructor->( map {$$_} @test_object_probe_list ) ; |
|
14
|
|
|
|
|
71
|
|
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
86
|
|
|
|
|
14165
|
@test_object_probe_list = (); |
419
|
|
|
|
|
|
|
|
420
|
86
|
|
|
|
|
162
|
my $unfreed_probes = [ grep { defined $_ } @{$probes} ]; |
|
605
|
|
|
|
|
1773
|
|
|
86
|
|
|
|
|
169
|
|
421
|
86
|
|
|
|
|
213
|
$self->{unfreed_probes} = $unfreed_probes; |
422
|
|
|
|
|
|
|
|
423
|
86
|
|
|
|
|
120
|
return scalar @{$unfreed_probes}; |
|
86
|
|
|
|
|
325
|
|
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
} # sub test |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# Undocumented and deprecated |
428
|
|
|
|
|
|
|
sub poof_array_return { |
429
|
|
|
|
|
|
|
|
430
|
2
|
|
|
2
|
|
5
|
my $tester = shift; |
431
|
2
|
|
|
|
|
12
|
my $results = $tester->{unfreed_probes}; |
432
|
|
|
|
|
|
|
|
433
|
2
|
|
|
|
|
5
|
my @unfreed_strong = (); |
434
|
2
|
|
|
|
|
3
|
my @unfreed_weak = (); |
435
|
2
|
|
|
|
|
4
|
for my $probe ( @{$results} ) { |
|
2
|
|
|
|
|
5
|
|
436
|
12
|
100
|
100
|
|
|
40
|
if ( ref $probe eq 'REF' and Scalar::Util::isweak ${$probe} ) { |
|
8
|
|
|
|
|
30
|
|
437
|
2
|
|
|
|
|
6
|
push @unfreed_weak, $probe; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
else { |
440
|
10
|
|
|
|
|
22
|
push @unfreed_strong, $probe; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
return ( |
445
|
2
|
|
|
|
|
21
|
$tester->weak_probe_count(), |
446
|
|
|
|
|
|
|
$tester->strong_probe_count(), |
447
|
|
|
|
|
|
|
\@unfreed_weak, \@unfreed_strong |
448
|
|
|
|
|
|
|
); |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
} ## end sub poof_array_return; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub Test::Weaken::poof { |
453
|
2
|
|
|
2
|
1
|
518
|
my @args = @_; |
454
|
2
|
|
|
|
|
17
|
my $tester = Test::Weaken->new(@args); |
455
|
2
|
|
|
|
|
8
|
my $result = $tester->test(); |
456
|
2
|
50
|
|
|
|
13
|
return Test::Weaken::Internal::poof_array_return($tester) if wantarray; |
457
|
0
|
|
|
|
|
0
|
return $result; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub Test::Weaken::leaks { |
461
|
78
|
|
|
78
|
1
|
37025
|
my @args = @_; |
462
|
78
|
|
|
|
|
416
|
my $tester = Test::Weaken->new(@args); |
463
|
78
|
|
|
|
|
225
|
my $result = $tester->test(); |
464
|
74
|
100
|
|
|
|
278
|
return $tester if $result; |
465
|
31
|
|
|
|
|
239
|
return; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub Test::Weaken::unfreed_proberefs { |
469
|
25
|
|
|
25
|
1
|
1454
|
my $tester = shift; |
470
|
25
|
|
|
|
|
49
|
my $result = $tester->{unfreed_probes}; |
471
|
25
|
50
|
|
|
|
82
|
if ( not defined $result ) { |
472
|
0
|
|
|
|
|
0
|
Carp::croak('Results not available for this Test::Weaken object'); |
473
|
|
|
|
|
|
|
} |
474
|
25
|
|
|
|
|
74
|
return $result; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub Test::Weaken::unfreed_count { |
478
|
25
|
|
|
25
|
1
|
4764
|
my $tester = shift; |
479
|
25
|
|
|
|
|
42
|
my $result = $tester->{unfreed_probes}; |
480
|
25
|
50
|
|
|
|
65
|
if ( not defined $result ) { |
481
|
0
|
|
|
|
|
0
|
Carp::croak('Results not available for this Test::Weaken object'); |
482
|
|
|
|
|
|
|
} |
483
|
25
|
|
|
|
|
30
|
return scalar @{$result}; |
|
25
|
|
|
|
|
112
|
|
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub Test::Weaken::probe_count { |
487
|
5
|
|
|
5
|
1
|
37
|
my $tester = shift; |
488
|
5
|
|
|
|
|
11
|
my $count = $tester->{probe_count}; |
489
|
5
|
50
|
|
|
|
18
|
if ( not defined $count ) { |
490
|
0
|
|
|
|
|
0
|
Carp::croak('Results not available for this Test::Weaken object'); |
491
|
|
|
|
|
|
|
} |
492
|
5
|
|
|
|
|
47
|
return $count; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Undocumented and deprecated |
496
|
|
|
|
|
|
|
sub Test::Weaken::weak_probe_count { |
497
|
10
|
|
|
10
|
0
|
161
|
my $tester = shift; |
498
|
10
|
|
|
|
|
18
|
my $count = $tester->{weak_probe_count}; |
499
|
10
|
50
|
|
|
|
26
|
if ( not defined $count ) { |
500
|
0
|
|
|
|
|
0
|
Carp::croak('Results not available for this Test::Weaken object'); |
501
|
|
|
|
|
|
|
} |
502
|
10
|
|
|
|
|
58
|
return $count; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# Undocumented and deprecated |
506
|
|
|
|
|
|
|
sub Test::Weaken::strong_probe_count { |
507
|
10
|
|
|
10
|
0
|
54
|
my $tester = shift; |
508
|
10
|
|
|
|
|
18
|
my $count = $tester->{strong_probe_count}; |
509
|
10
|
50
|
|
|
|
34
|
if ( not defined $count ) { |
510
|
0
|
|
|
|
|
0
|
Carp::croak('Results not available for this Test::Weaken object'); |
511
|
|
|
|
|
|
|
} |
512
|
10
|
|
|
|
|
84
|
return $count; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
sub Test::Weaken::check_ignore { |
516
|
18
|
|
|
18
|
1
|
29648
|
my ( $ignore, $max_errors, $compare_depth, $reporting_depth ) = @_; |
517
|
|
|
|
|
|
|
|
518
|
18
|
|
|
|
|
32
|
my $error_count = 0; |
519
|
|
|
|
|
|
|
|
520
|
18
|
100
|
|
|
|
56
|
$max_errors = 1 if not defined $max_errors; |
521
|
18
|
50
|
|
|
|
98
|
if ( not Scalar::Util::looks_like_number($max_errors) ) { |
522
|
0
|
|
|
|
|
0
|
Carp::croak('Test::Weaken::check_ignore max_errors must be a number'); |
523
|
|
|
|
|
|
|
} |
524
|
18
|
100
|
|
|
|
49
|
$max_errors = 0 if $max_errors <= 0; |
525
|
|
|
|
|
|
|
|
526
|
18
|
100
|
|
|
|
43
|
$reporting_depth = -1 if not defined $reporting_depth; |
527
|
18
|
50
|
|
|
|
130
|
if ( not Scalar::Util::looks_like_number($reporting_depth) ) { |
528
|
0
|
|
|
|
|
0
|
Carp::croak( |
529
|
|
|
|
|
|
|
'Test::Weaken::check_ignore reporting_depth must be a number'); |
530
|
|
|
|
|
|
|
} |
531
|
18
|
100
|
|
|
|
44
|
$reporting_depth = -1 if $reporting_depth < 0; |
532
|
|
|
|
|
|
|
|
533
|
18
|
100
|
|
|
|
134
|
$compare_depth = 0 if not defined $compare_depth; |
534
|
18
|
50
|
33
|
|
|
172
|
if ( not Scalar::Util::looks_like_number($compare_depth) |
535
|
|
|
|
|
|
|
or $compare_depth < 0 ) |
536
|
|
|
|
|
|
|
{ |
537
|
0
|
|
|
|
|
0
|
Carp::croak( |
538
|
|
|
|
|
|
|
'Test::Weaken::check_ignore compare_depth must be a non-negative number' |
539
|
|
|
|
|
|
|
); |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
return sub { |
543
|
239
|
|
|
239
|
|
284
|
my ($probe_ref) = @_; |
544
|
|
|
|
|
|
|
|
545
|
239
|
|
|
|
|
296
|
my $array_context = wantarray; |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
my $before_weak = |
548
|
|
|
|
|
|
|
( ref $probe_ref eq 'REF' |
549
|
239
|
|
100
|
|
|
595
|
and Scalar::Util::isweak( ${$probe_ref} ) ); |
550
|
239
|
|
|
|
|
5472
|
my $before_dump = |
551
|
|
|
|
|
|
|
Data::Dumper->new( [$probe_ref], [qw(proberef)] ) |
552
|
|
|
|
|
|
|
->Maxdepth($compare_depth)->Dump(); |
553
|
239
|
|
|
|
|
14805
|
my $before_reporting_dump; |
554
|
239
|
100
|
|
|
|
571
|
if ( $reporting_depth >= 0 ) { |
555
|
|
|
|
|
|
|
#<<< perltidy doesn't do this well |
556
|
150
|
|
|
|
|
614
|
$before_reporting_dump = |
557
|
|
|
|
|
|
|
Data::Dumper->new( |
558
|
|
|
|
|
|
|
[$probe_ref], |
559
|
|
|
|
|
|
|
[qw(proberef_before_callback)] |
560
|
|
|
|
|
|
|
) |
561
|
|
|
|
|
|
|
->Maxdepth($reporting_depth) |
562
|
|
|
|
|
|
|
->Dump(); |
563
|
|
|
|
|
|
|
#>>> |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
|
566
|
239
|
|
|
|
|
8667
|
my $scalar_return_value; |
567
|
|
|
|
|
|
|
my @array_return_value; |
568
|
239
|
50
|
|
|
|
453
|
if ($array_context) { |
569
|
0
|
|
|
|
|
0
|
@array_return_value = $ignore->($probe_ref); |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
else { |
572
|
239
|
|
|
|
|
524
|
$scalar_return_value = $ignore->($probe_ref); |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
my $after_weak = |
576
|
|
|
|
|
|
|
( ref $probe_ref eq 'REF' |
577
|
239
|
|
66
|
|
|
2607
|
and Scalar::Util::isweak( ${$probe_ref} ) ); |
578
|
239
|
|
|
|
|
971
|
my $after_dump = |
579
|
|
|
|
|
|
|
Data::Dumper->new( [$probe_ref], [qw(proberef)] ) |
580
|
|
|
|
|
|
|
->Maxdepth($compare_depth)->Dump(); |
581
|
239
|
|
|
|
|
13650
|
my $after_reporting_dump; |
582
|
239
|
100
|
|
|
|
538
|
if ( $reporting_depth >= 0 ) { |
583
|
|
|
|
|
|
|
#<<< perltidy doesn't do this well |
584
|
150
|
|
|
|
|
596
|
$after_reporting_dump = |
585
|
|
|
|
|
|
|
Data::Dumper->new( |
586
|
|
|
|
|
|
|
[$probe_ref], |
587
|
|
|
|
|
|
|
[qw(proberef_after_callback)] |
588
|
|
|
|
|
|
|
) |
589
|
|
|
|
|
|
|
->Maxdepth($reporting_depth) |
590
|
|
|
|
|
|
|
->Dump(); |
591
|
|
|
|
|
|
|
#<<< |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
239
|
|
|
|
|
8408
|
my $problems = q{}; |
595
|
239
|
|
|
|
|
274
|
my $include_before = 0; |
596
|
239
|
|
|
|
|
252
|
my $include_after = 0; |
597
|
|
|
|
|
|
|
|
598
|
239
|
100
|
|
|
|
483
|
if ( $before_weak != $after_weak ) { |
599
|
1
|
50
|
|
|
|
4
|
my $changed = $before_weak ? 'strengthened' : 'weakened'; |
600
|
1
|
|
|
|
|
4
|
$problems .= "Probe referent $changed by ignore call\n"; |
601
|
1
|
|
|
|
|
3
|
$include_before = defined $before_reporting_dump; |
602
|
|
|
|
|
|
|
} |
603
|
239
|
100
|
|
|
|
453
|
if ( $before_dump ne $after_dump ) { |
604
|
27
|
|
|
|
|
46
|
$problems .= "Probe referent changed by ignore call\n"; |
605
|
27
|
|
|
|
|
36
|
$include_before = defined $before_reporting_dump; |
606
|
27
|
|
|
|
|
36
|
$include_after = defined $after_reporting_dump; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
|
609
|
239
|
100
|
|
|
|
376
|
if ($problems) { |
610
|
|
|
|
|
|
|
|
611
|
28
|
|
|
|
|
31
|
$error_count++; |
612
|
|
|
|
|
|
|
|
613
|
28
|
|
|
|
|
33
|
my $message = q{}; |
614
|
28
|
100
|
|
|
|
50
|
$message .= $before_reporting_dump |
615
|
|
|
|
|
|
|
if $include_before; |
616
|
28
|
100
|
|
|
|
51
|
$message .= $after_reporting_dump |
617
|
|
|
|
|
|
|
if $include_after; |
618
|
28
|
|
|
|
|
38
|
$message .= $problems; |
619
|
|
|
|
|
|
|
|
620
|
28
|
100
|
100
|
|
|
101
|
if ( $max_errors > 0 and $error_count >= $max_errors ) { |
621
|
4
|
|
|
|
|
10
|
$message |
622
|
|
|
|
|
|
|
.= "Terminating ignore callbacks after finding $error_count error(s)"; |
623
|
4
|
|
|
|
|
572
|
Carp::croak($message); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
24
|
|
|
|
|
4318
|
Carp::carp( $message . 'Above errors reported' ); |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
235
|
50
|
|
|
|
1923
|
return $array_context ? @array_return_value : $scalar_return_value; |
631
|
|
|
|
|
|
|
|
632
|
18
|
|
|
|
|
216
|
}; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
1; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
__END__ |