|
1 This patch is an update of Data-Dumper to version 2.154 that comes from: |
|
2 http://search.cpan.org/~smueller/Data-Dumper-2.154/Dumper.pm |
|
3 |
|
4 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/Changes perl-5.12.5_dumper/dist/Data-Dumper/Changes |
|
5 --- perl-5.12.5/dist/Data-Dumper/Changes 2012-11-03 19:25:59.000000000 -0400 |
|
6 +++ perl-5.12.5_dumper/dist/Data-Dumper/Changes 2014-10-09 15:06:36.166260359 -0400 |
|
7 @@ -1,11 +1,165 @@ |
|
8 =head1 NAME |
|
9 |
|
10 -HISTORY - public release history for Data::Dumper |
|
11 +Changes - public release history for Data::Dumper |
|
12 |
|
13 =head1 DESCRIPTION |
|
14 |
|
15 =over 8 |
|
16 |
|
17 +=item 2.154 (Sep 18 2014) |
|
18 + |
|
19 +Most notably, this release fixes CVE-2014-4330: |
|
20 + |
|
21 + Don't recurse infinitely in Data::Dumper |
|
22 + |
|
23 + Add a configuration variable/option to limit recursion when dumping |
|
24 + deep data structures. |
|
25 + [...] |
|
26 + This patch addresses CVE-2014-4330. This bug was found and |
|
27 + reported by: LSE Leading Security Experts GmbH employee Markus |
|
28 + Vervier. |
|
29 + |
|
30 +On top of that, there are several minor big fixes and improvements, |
|
31 +see "git log" if the core perl distribution for details. |
|
32 + |
|
33 +=item 2.151 (Mar 7 2014) |
|
34 + |
|
35 +A "useqq" implementation for the XS version of Data::Dumper. |
|
36 + |
|
37 +Better compatibility wrt. hash key quoting between PP and XS |
|
38 +versions of Data::Dumper. |
|
39 + |
|
40 +EBCDIC fixes. |
|
41 + |
|
42 +64bit safety fixes (for very large arrays). |
|
43 + |
|
44 +Build fixes for threaded perls. |
|
45 + |
|
46 +clang warning fixes. |
|
47 + |
|
48 +Warning fixes in tests on older perls. |
|
49 + |
|
50 +Typo fixes in documentation. |
|
51 + |
|
52 +=item 2.145 (Mar 15 2013) |
|
53 + |
|
54 +Test refactoring and fixing wide and far. |
|
55 + |
|
56 +Various old-perl compat fixes. |
|
57 + |
|
58 +=item 2.143 (Feb 26 2013) |
|
59 + |
|
60 +Address vstring related test failures on 5.8: Skip tests for |
|
61 +obscure case. |
|
62 + |
|
63 +Major improvements to test coverage and significant refactoring. |
|
64 + |
|
65 +Make Data::Dumper XS ignore Freezer return value. Fixes RT #116364. |
|
66 + |
|
67 +Change call of isALNUM to equivalent but more clearly named isWORDCHAR |
|
68 + |
|
69 +=item 2.139 (Dec 12 2012) |
|
70 + |
|
71 +Supply an explicit dynamic_config => 0 in META |
|
72 + |
|
73 +Properly list BUILD_REQUIRES prereqs (P5-RT#116028) |
|
74 + |
|
75 +Some optimizations. Removed useless "register" declarations. |
|
76 + |
|
77 +=item 2.136 (Oct 04 2012) |
|
78 + |
|
79 +Promote to stable release. |
|
80 + |
|
81 +Drop some "register" declarations. |
|
82 + |
|
83 +=item 2.135_07 (Aug 06 2012) |
|
84 + |
|
85 +Use the new utf8 to code point functions - fixing a potential |
|
86 +reading buffer overrun. |
|
87 + |
|
88 +Data::Dumper: Sparseseen option to avoid building much of the seen |
|
89 +hash: This has been measured to, in some cases, provide a 50% speed-up |
|
90 + |
|
91 +Dumper.xs: Avoid scan_vstring on 5.17.3 and up |
|
92 + |
|
93 +Avoid a warning from clang when compiling Data::Dumper |
|
94 + |
|
95 +Fix DD's dumping of qr|\/| |
|
96 + |
|
97 +Data::Dumper's Perl implementation was not working with overloaded |
|
98 +blessed globs, which it thought were strings. |
|
99 + |
|
100 +Allow Data::Dumper to load on miniperl |
|
101 + |
|
102 +=item 2.135_02 (Dec 29 2011) |
|
103 + |
|
104 +Makes DD dump *{''} properly. |
|
105 + |
|
106 +[perl #101162] DD support for vstrings: |
|
107 +Support for vstrings to Data::Dumper, in both Perl and XS |
|
108 +implementations. |
|
109 + |
|
110 +=item 2.135_01 (Dec 19 2011) |
|
111 + |
|
112 +Make Data::Dumper UTF8- and null-clean with GVs. |
|
113 + |
|
114 +In Dumper.xs, use sv_newmortal() instead of sv_mortalcopy(&PL_sv_undef) |
|
115 +for efficiency. |
|
116 + |
|
117 +Suppress compiler warning |
|
118 + |
|
119 +Keep verbatim pod in Data::Dumper within 80 cols |
|
120 + |
|
121 +=item 2.131 (May 27 2011) |
|
122 + |
|
123 +Essentially the same as version 2.130_02, but a production release. |
|
124 + |
|
125 +=item 2.130_03 (May 20 2011) |
|
126 + |
|
127 +Essentially the same as version 2.130_02, but a CPAN release |
|
128 +for the eventual 2.131. |
|
129 + |
|
130 +=item 2.130_02 |
|
131 + |
|
132 +This was only shipped with the perl core, never released to CPAN. |
|
133 + |
|
134 +Convert overload.t to Test::More |
|
135 + |
|
136 +Fix some spelling errors |
|
137 + |
|
138 +Fix some compiler warnings |
|
139 + |
|
140 +Fix an out of bounds write in Data-Dumper with malformed utf8 input |
|
141 + |
|
142 +=item 2.130 (Nov 20 2010) |
|
143 + |
|
144 +C<Dumpxs> can now handle malformed UTF-8. |
|
145 + |
|
146 +=item 2.129 (Oct 20 2010) |
|
147 + |
|
148 +C<Dumpxs> no longer crashes with globs returned by C<*$io_ref> |
|
149 +[perl #72332]. |
|
150 + |
|
151 +=item 2.128 (Sep 10 2010) |
|
152 + |
|
153 +Promote previous release to stable version with the correct version. |
|
154 + |
|
155 +=item 2.127 (Sep 10 2010) |
|
156 + |
|
157 +Promote previous release to stable version. |
|
158 + |
|
159 +=item 2.126_01 (Sep 6 2010) |
|
160 + |
|
161 +Port core perl changes e3ec2293dc, fe642606b19. |
|
162 +Fixes core perl RT #74170 (handle the stack changing in the |
|
163 +custom sort functions) and adds a test. |
|
164 + |
|
165 +=item 2.126 (Apr 15 2010) |
|
166 + |
|
167 +Fix Data::Dumper's Fix Terse(1) + Indent(2): |
|
168 +perl-RT #73604: When $Data::Dumper::Terse is true, the indentation is thrown |
|
169 +off. It appears to be acting as if the $VAR1 = is still there. |
|
170 + |
|
171 =item 2.125 (Aug 8 2009) |
|
172 |
|
173 CPAN distribution fixes (meta information for META.yml). |
|
174 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/Dumper.pm perl-5.12.5_dumper/dist/Data-Dumper/Dumper.pm |
|
175 --- perl-5.12.5/dist/Data-Dumper/Dumper.pm 2012-11-03 19:25:59.000000000 -0400 |
|
176 +++ perl-5.12.5_dumper/dist/Data-Dumper/Dumper.pm 2014-10-09 15:06:36.167092691 -0400 |
|
177 @@ -9,7 +9,9 @@ |
|
178 |
|
179 package Data::Dumper; |
|
180 |
|
181 -$VERSION = '2.125'; # Don't forget to set version and release date in POD! |
|
182 +BEGIN { |
|
183 + $VERSION = '2.154'; # Don't forget to set version and release |
|
184 +} # date in POD below! |
|
185 |
|
186 #$| = 1; |
|
187 |
|
188 @@ -28,13 +30,13 @@ |
|
189 # XSLoader should be attempted to load, or the pure perl flag |
|
190 # toggled on load failure. |
|
191 eval { |
|
192 - require XSLoader; |
|
193 - }; |
|
194 - $Useperl = 1 if $@; |
|
195 + require XSLoader; |
|
196 + XSLoader::load( 'Data::Dumper' ); |
|
197 + 1 |
|
198 + } |
|
199 + or $Useperl = 1; |
|
200 } |
|
201 |
|
202 -XSLoader::load( 'Data::Dumper' ) unless $Useperl; |
|
203 - |
|
204 # module vars and their defaults |
|
205 $Indent = 2 unless defined $Indent; |
|
206 $Purity = 0 unless defined $Purity; |
|
207 @@ -53,6 +55,8 @@ |
|
208 $Useperl = 0 unless defined $Useperl; |
|
209 $Sortkeys = 0 unless defined $Sortkeys; |
|
210 $Deparse = 0 unless defined $Deparse; |
|
211 +$Sparseseen = 0 unless defined $Sparseseen; |
|
212 +$Maxrecurse = 1000 unless defined $Maxrecurse; |
|
213 |
|
214 # |
|
215 # expects an arrayref of values to be dumped. |
|
216 @@ -63,36 +67,38 @@ |
|
217 sub new { |
|
218 my($c, $v, $n) = @_; |
|
219 |
|
220 - croak "Usage: PACKAGE->new(ARRAYREF, [ARRAYREF])" |
|
221 + croak "Usage: PACKAGE->new(ARRAYREF, [ARRAYREF])" |
|
222 unless (defined($v) && (ref($v) eq 'ARRAY')); |
|
223 $n = [] unless (defined($n) && (ref($n) eq 'ARRAY')); |
|
224 |
|
225 - my($s) = { |
|
226 - level => 0, # current recursive depth |
|
227 - indent => $Indent, # various styles of indenting |
|
228 - pad => $Pad, # all lines prefixed by this string |
|
229 - xpad => "", # padding-per-level |
|
230 - apad => "", # added padding for hash keys n such |
|
231 - sep => "", # list separator |
|
232 - pair => $Pair, # hash key/value separator: defaults to ' => ' |
|
233 - seen => {}, # local (nested) refs (id => [name, val]) |
|
234 - todump => $v, # values to dump [] |
|
235 - names => $n, # optional names for values [] |
|
236 - varname => $Varname, # prefix to use for tagging nameless ones |
|
237 - purity => $Purity, # degree to which output is evalable |
|
238 - useqq => $Useqq, # use "" for strings (backslashitis ensues) |
|
239 - terse => $Terse, # avoid name output (where feasible) |
|
240 - freezer => $Freezer, # name of Freezer method for objects |
|
241 - toaster => $Toaster, # name of method to revive objects |
|
242 - deepcopy => $Deepcopy, # dont cross-ref, except to stop recursion |
|
243 - quotekeys => $Quotekeys, # quote hash keys |
|
244 - 'bless' => $Bless, # keyword to use for "bless" |
|
245 -# expdepth => $Expdepth, # cutoff depth for explicit dumping |
|
246 - maxdepth => $Maxdepth, # depth beyond which we give up |
|
247 - useperl => $Useperl, # use the pure Perl implementation |
|
248 - sortkeys => $Sortkeys, # flag or filter for sorting hash keys |
|
249 - deparse => $Deparse, # use B::Deparse for coderefs |
|
250 - }; |
|
251 + my($s) = { |
|
252 + level => 0, # current recursive depth |
|
253 + indent => $Indent, # various styles of indenting |
|
254 + pad => $Pad, # all lines prefixed by this string |
|
255 + xpad => "", # padding-per-level |
|
256 + apad => "", # added padding for hash keys n such |
|
257 + sep => "", # list separator |
|
258 + pair => $Pair, # hash key/value separator: defaults to ' => ' |
|
259 + seen => {}, # local (nested) refs (id => [name, val]) |
|
260 + todump => $v, # values to dump [] |
|
261 + names => $n, # optional names for values [] |
|
262 + varname => $Varname, # prefix to use for tagging nameless ones |
|
263 + purity => $Purity, # degree to which output is evalable |
|
264 + useqq => $Useqq, # use "" for strings (backslashitis ensues) |
|
265 + terse => $Terse, # avoid name output (where feasible) |
|
266 + freezer => $Freezer, # name of Freezer method for objects |
|
267 + toaster => $Toaster, # name of method to revive objects |
|
268 + deepcopy => $Deepcopy, # do not cross-ref, except to stop recursion |
|
269 + quotekeys => $Quotekeys, # quote hash keys |
|
270 + 'bless' => $Bless, # keyword to use for "bless" |
|
271 +# expdepth => $Expdepth, # cutoff depth for explicit dumping |
|
272 + maxdepth => $Maxdepth, # depth beyond which we give up |
|
273 + maxrecurse => $Maxrecurse, # depth beyond which we abort |
|
274 + useperl => $Useperl, # use the pure Perl implementation |
|
275 + sortkeys => $Sortkeys, # flag or filter for sorting hash keys |
|
276 + deparse => $Deparse, # use B::Deparse for coderefs |
|
277 + noseen => $Sparseseen, # do not populate the seen hash unless necessary |
|
278 + }; |
|
279 |
|
280 if ($Indent > 0) { |
|
281 $s->{xpad} = " "; |
|
282 @@ -101,26 +107,39 @@ |
|
283 return bless($s, $c); |
|
284 } |
|
285 |
|
286 -if ($] >= 5.008) { |
|
287 - # Packed numeric addresses take less memory. Plus pack is faster than sprintf |
|
288 - *init_refaddr_format = sub {}; |
|
289 +# Packed numeric addresses take less memory. Plus pack is faster than sprintf |
|
290 + |
|
291 +# Most users of current versions of Data::Dumper will be 5.008 or later. |
|
292 +# Anyone on 5.6.1 and 5.6.2 upgrading will be rare (particularly judging by |
|
293 +# the bug reports from users on those platforms), so for the common case avoid |
|
294 +# complexity, and avoid even compiling the unneeded code. |
|
295 |
|
296 - *format_refaddr = sub { |
|
297 +sub init_refaddr_format { |
|
298 +} |
|
299 + |
|
300 +sub format_refaddr { |
|
301 require Scalar::Util; |
|
302 pack "J", Scalar::Util::refaddr(shift); |
|
303 - }; |
|
304 -} else { |
|
305 - *init_refaddr_format = sub { |
|
306 - require Config; |
|
307 - my $f = $Config::Config{uvxformat}; |
|
308 - $f =~ tr/"//d; |
|
309 - our $refaddr_format = "0x%" . $f; |
|
310 - }; |
|
311 +}; |
|
312 |
|
313 - *format_refaddr = sub { |
|
314 - require Scalar::Util; |
|
315 - sprintf our $refaddr_format, Scalar::Util::refaddr(shift); |
|
316 - } |
|
317 +if ($] < 5.008) { |
|
318 + eval <<'EOC' or die; |
|
319 + no warnings 'redefine'; |
|
320 + my $refaddr_format; |
|
321 + sub init_refaddr_format { |
|
322 + require Config; |
|
323 + my $f = $Config::Config{uvxformat}; |
|
324 + $f =~ tr/"//d; |
|
325 + $refaddr_format = "0x%" . $f; |
|
326 + } |
|
327 + |
|
328 + sub format_refaddr { |
|
329 + require Scalar::Util; |
|
330 + sprintf $refaddr_format, Scalar::Util::refaddr(shift); |
|
331 + } |
|
332 + |
|
333 + 1 |
|
334 +EOC |
|
335 } |
|
336 |
|
337 # |
|
338 @@ -132,21 +151,26 @@ |
|
339 init_refaddr_format(); |
|
340 my($k, $v, $id); |
|
341 while (($k, $v) = each %$g) { |
|
342 - if (defined $v and ref $v) { |
|
343 - $id = format_refaddr($v); |
|
344 - if ($k =~ /^[*](.*)$/) { |
|
345 - $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) : |
|
346 - (ref $v eq 'HASH') ? ( "\\\%" . $1 ) : |
|
347 - (ref $v eq 'CODE') ? ( "\\\&" . $1 ) : |
|
348 - ( "\$" . $1 ) ; |
|
349 - } |
|
350 - elsif ($k !~ /^\$/) { |
|
351 - $k = "\$" . $k; |
|
352 - } |
|
353 - $s->{seen}{$id} = [$k, $v]; |
|
354 + if (defined $v) { |
|
355 + if (ref $v) { |
|
356 + $id = format_refaddr($v); |
|
357 + if ($k =~ /^[*](.*)$/) { |
|
358 + $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) : |
|
359 + (ref $v eq 'HASH') ? ( "\\\%" . $1 ) : |
|
360 + (ref $v eq 'CODE') ? ( "\\\&" . $1 ) : |
|
361 + ( "\$" . $1 ) ; |
|
362 + } |
|
363 + elsif ($k !~ /^\$/) { |
|
364 + $k = "\$" . $k; |
|
365 + } |
|
366 + $s->{seen}{$id} = [$k, $v]; |
|
367 + } |
|
368 + else { |
|
369 + carp "Only refs supported, ignoring non-ref item \$$k"; |
|
370 + } |
|
371 } |
|
372 else { |
|
373 - carp "Only refs supported, ignoring non-ref item \$$k"; |
|
374 + carp "Value of ref must be defined; ignoring undefined item \$$k"; |
|
375 } |
|
376 } |
|
377 return $s; |
|
378 @@ -161,9 +185,14 @@ |
|
379 # |
|
380 sub Values { |
|
381 my($s, $v) = @_; |
|
382 - if (defined($v) && (ref($v) eq 'ARRAY')) { |
|
383 - $s->{todump} = [@$v]; # make a copy |
|
384 - return $s; |
|
385 + if (defined($v)) { |
|
386 + if (ref($v) eq 'ARRAY') { |
|
387 + $s->{todump} = [@$v]; # make a copy |
|
388 + return $s; |
|
389 + } |
|
390 + else { |
|
391 + croak "Argument to Values, if provided, must be array ref"; |
|
392 + } |
|
393 } |
|
394 else { |
|
395 return @{$s->{todump}}; |
|
396 @@ -175,9 +204,14 @@ |
|
397 # |
|
398 sub Names { |
|
399 my($s, $n) = @_; |
|
400 - if (defined($n) && (ref($n) eq 'ARRAY')) { |
|
401 - $s->{names} = [@$n]; # make a copy |
|
402 - return $s; |
|
403 + if (defined($n)) { |
|
404 + if (ref($n) eq 'ARRAY') { |
|
405 + $s->{names} = [@$n]; # make a copy |
|
406 + return $s; |
|
407 + } |
|
408 + else { |
|
409 + croak "Argument to Names, if provided, must be array ref"; |
|
410 + } |
|
411 } |
|
412 else { |
|
413 return @{$s->{names}}; |
|
414 @@ -188,9 +222,8 @@ |
|
415 |
|
416 sub Dump { |
|
417 return &Dumpxs |
|
418 - unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) || |
|
419 - $Data::Dumper::Useqq || (ref($_[0]) && $_[0]->{useqq}) || |
|
420 - $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse}); |
|
421 + unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) || |
|
422 + $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse}); |
|
423 return &Dumpperl; |
|
424 } |
|
425 |
|
426 @@ -208,40 +241,19 @@ |
|
427 $s = $s->new(@_) unless ref $s; |
|
428 |
|
429 for $val (@{$s->{todump}}) { |
|
430 - my $out = ""; |
|
431 @post = (); |
|
432 $name = $s->{names}[$i++]; |
|
433 - if (defined $name) { |
|
434 - if ($name =~ /^[*](.*)$/) { |
|
435 - if (defined $val) { |
|
436 - $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) : |
|
437 - (ref $val eq 'HASH') ? ( "\%" . $1 ) : |
|
438 - (ref $val eq 'CODE') ? ( "\*" . $1 ) : |
|
439 - ( "\$" . $1 ) ; |
|
440 - } |
|
441 - else { |
|
442 - $name = "\$" . $1; |
|
443 - } |
|
444 - } |
|
445 - elsif ($name !~ /^\$/) { |
|
446 - $name = "\$" . $name; |
|
447 - } |
|
448 - } |
|
449 - else { |
|
450 - $name = "\$" . $s->{varname} . $i; |
|
451 - } |
|
452 + $name = $s->_refine_name($name, $val, $i); |
|
453 |
|
454 my $valstr; |
|
455 { |
|
456 local($s->{apad}) = $s->{apad}; |
|
457 - $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2; |
|
458 + $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2 and !$s->{terse}; |
|
459 $valstr = $s->_dump($val, $name); |
|
460 } |
|
461 |
|
462 $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse}; |
|
463 - $out .= $s->{pad} . $valstr . $s->{sep}; |
|
464 - $out .= $s->{pad} . join(';' . $s->{sep} . $s->{pad}, @post) |
|
465 - . ';' . $s->{sep} if @post; |
|
466 + my $out = $s->_compose_out($valstr, \@post); |
|
467 |
|
468 push @out, $out; |
|
469 } |
|
470 @@ -255,6 +267,10 @@ |
|
471 return "'" . $val . "'"; |
|
472 } |
|
473 |
|
474 +# Old Perls (5.14-) have trouble resetting vstring magic when it is no |
|
475 +# longer valid. |
|
476 +use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0"; |
|
477 + |
|
478 # |
|
479 # twist, toil and turn; |
|
480 # and recurse, of course. |
|
481 @@ -263,8 +279,7 @@ |
|
482 # |
|
483 sub _dump { |
|
484 my($s, $val, $name) = @_; |
|
485 - my($sname); |
|
486 - my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad); |
|
487 + my($out, $type, $id, $sname); |
|
488 |
|
489 $type = ref $val; |
|
490 $out = ""; |
|
491 @@ -281,65 +296,70 @@ |
|
492 } |
|
493 |
|
494 require Scalar::Util; |
|
495 - $realpack = Scalar::Util::blessed($val); |
|
496 - $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val; |
|
497 + my $realpack = Scalar::Util::blessed($val); |
|
498 + my $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val; |
|
499 $id = format_refaddr($val); |
|
500 |
|
501 - # if it has a name, we need to either look it up, or keep a tab |
|
502 - # on it so we know when we hit it later |
|
503 - if (defined($name) and length($name)) { |
|
504 - # keep a tab on it so that we dont fall into recursive pit |
|
505 - if (exists $s->{seen}{$id}) { |
|
506 -# if ($s->{expdepth} < $s->{level}) { |
|
507 - if ($s->{purity} and $s->{level} > 0) { |
|
508 - $out = ($realtype eq 'HASH') ? '{}' : |
|
509 - ($realtype eq 'ARRAY') ? '[]' : |
|
510 - 'do{my $o}' ; |
|
511 - push @post, $name . " = " . $s->{seen}{$id}[0]; |
|
512 - } |
|
513 - else { |
|
514 - $out = $s->{seen}{$id}[0]; |
|
515 - if ($name =~ /^([\@\%])/) { |
|
516 - my $start = $1; |
|
517 - if ($out =~ /^\\$start/) { |
|
518 - $out = substr($out, 1); |
|
519 - } |
|
520 - else { |
|
521 - $out = $start . '{' . $out . '}'; |
|
522 - } |
|
523 - } |
|
524 - } |
|
525 - return $out; |
|
526 -# } |
|
527 + # Note: By this point $name is always defined and of non-zero length. |
|
528 + # Keep a tab on it so that we do not fall into recursive pit. |
|
529 + if (exists $s->{seen}{$id}) { |
|
530 + if ($s->{purity} and $s->{level} > 0) { |
|
531 + $out = ($realtype eq 'HASH') ? '{}' : |
|
532 + ($realtype eq 'ARRAY') ? '[]' : |
|
533 + 'do{my $o}' ; |
|
534 + push @post, $name . " = " . $s->{seen}{$id}[0]; |
|
535 } |
|
536 else { |
|
537 - # store our name |
|
538 - $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) : |
|
539 - ($realtype eq 'CODE' and |
|
540 - $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) : |
|
541 - $name ), |
|
542 - $val ]; |
|
543 + $out = $s->{seen}{$id}[0]; |
|
544 + if ($name =~ /^([\@\%])/) { |
|
545 + my $start = $1; |
|
546 + if ($out =~ /^\\$start/) { |
|
547 + $out = substr($out, 1); |
|
548 + } |
|
549 + else { |
|
550 + $out = $start . '{' . $out . '}'; |
|
551 + } |
|
552 + } |
|
553 } |
|
554 + return $out; |
|
555 } |
|
556 - my $no_bless = 0; |
|
557 + else { |
|
558 + # store our name |
|
559 + $s->{seen}{$id} = [ ( |
|
560 + ($name =~ /^[@%]/) |
|
561 + ? ('\\' . $name ) |
|
562 + : ($realtype eq 'CODE' and $name =~ /^[*](.*)$/) |
|
563 + ? ('\\&' . $1 ) |
|
564 + : $name |
|
565 + ), $val ]; |
|
566 + } |
|
567 + my $no_bless = 0; |
|
568 my $is_regex = 0; |
|
569 if ( $realpack and ($] >= 5.009005 ? re::is_regexp($val) : $realpack eq 'Regexp') ) { |
|
570 $is_regex = 1; |
|
571 $no_bless = $realpack eq 'Regexp'; |
|
572 } |
|
573 |
|
574 - # If purity is not set and maxdepth is set, then check depth: |
|
575 + # If purity is not set and maxdepth is set, then check depth: |
|
576 # if we have reached maximum depth, return the string |
|
577 # representation of the thing we are currently examining |
|
578 - # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)'). |
|
579 + # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)'). |
|
580 if (!$s->{purity} |
|
581 - and $s->{maxdepth} > 0 |
|
582 - and $s->{level} >= $s->{maxdepth}) |
|
583 + and defined($s->{maxdepth}) |
|
584 + and $s->{maxdepth} > 0 |
|
585 + and $s->{level} >= $s->{maxdepth}) |
|
586 { |
|
587 return qq['$val']; |
|
588 } |
|
589 |
|
590 + # avoid recursing infinitely [perl #122111] |
|
591 + if ($s->{maxrecurse} > 0 |
|
592 + and $s->{level} >= $s->{maxrecurse}) { |
|
593 + die "Recursion limit of $s->{maxrecurse} exceeded"; |
|
594 + } |
|
595 + |
|
596 # we have a blessed ref |
|
597 + my ($blesspad); |
|
598 if ($realpack and !$no_bless) { |
|
599 $out = $s->{'bless'} . '( '; |
|
600 $blesspad = $s->{apad}; |
|
601 @@ -347,186 +367,208 @@ |
|
602 } |
|
603 |
|
604 $s->{level}++; |
|
605 - $ipad = $s->{xpad} x $s->{level}; |
|
606 + my $ipad = $s->{xpad} x $s->{level}; |
|
607 |
|
608 if ($is_regex) { |
|
609 my $pat; |
|
610 - # This really sucks, re:regexp_pattern is in ext/re/re.xs and not in |
|
611 - # universal.c, and even worse we cant just require that re to be loaded |
|
612 - # we *have* to use() it. |
|
613 - # We should probably move it to universal.c for 5.10.1 and fix this. |
|
614 - # Currently we only use re::regexp_pattern when the re is blessed into another |
|
615 - # package. This has the disadvantage of meaning that a DD dump won't round trip |
|
616 - # as the pattern will be repeatedly wrapped with the same modifiers. |
|
617 - # This is an aesthetic issue so we will leave it for now, but we could use |
|
618 - # regexp_pattern() in list context to get the modifiers separately. |
|
619 - # But since this means loading the full debugging engine in process we wont |
|
620 - # bother unless its necessary for accuracy. |
|
621 - if (($realpack ne 'Regexp') && defined(*re::regexp_pattern{CODE})) { |
|
622 - $pat = re::regexp_pattern($val); |
|
623 - } else { |
|
624 - $pat = "$val"; |
|
625 + my $flags = ""; |
|
626 + if (defined(*re::regexp_pattern{CODE})) { |
|
627 + ($pat, $flags) = re::regexp_pattern($val); |
|
628 + } |
|
629 + else { |
|
630 + $pat = "$val"; |
|
631 } |
|
632 - $pat =~ s,/,\\/,g; |
|
633 - $out .= "qr/$pat/"; |
|
634 + $pat =~ s <(\\.)|/> { $1 || '\\/' }ge; |
|
635 + $out .= "qr/$pat/$flags"; |
|
636 } |
|
637 - elsif ($realtype eq 'SCALAR' || $realtype eq 'REF') { |
|
638 + elsif ($realtype eq 'SCALAR' || $realtype eq 'REF' |
|
639 + || $realtype eq 'VSTRING') { |
|
640 if ($realpack) { |
|
641 - $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}'; |
|
642 + $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}'; |
|
643 } |
|
644 else { |
|
645 - $out .= '\\' . $s->_dump($$val, "\${$name}"); |
|
646 + $out .= '\\' . $s->_dump($$val, "\${$name}"); |
|
647 } |
|
648 } |
|
649 elsif ($realtype eq 'GLOB') { |
|
650 - $out .= '\\' . $s->_dump($$val, "*{$name}"); |
|
651 + $out .= '\\' . $s->_dump($$val, "*{$name}"); |
|
652 } |
|
653 elsif ($realtype eq 'ARRAY') { |
|
654 my($pad, $mname); |
|
655 my($i) = 0; |
|
656 $out .= ($name =~ /^\@/) ? '(' : '['; |
|
657 $pad = $s->{sep} . $s->{pad} . $s->{apad}; |
|
658 - ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : |
|
659 - # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} |
|
660 - ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : |
|
661 - ($mname = $name . '->'); |
|
662 + ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : |
|
663 + # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} |
|
664 + ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : |
|
665 + ($mname = $name . '->'); |
|
666 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; |
|
667 for my $v (@$val) { |
|
668 - $sname = $mname . '[' . $i . ']'; |
|
669 - $out .= $pad . $ipad . '#' . $i if $s->{indent} >= 3; |
|
670 - $out .= $pad . $ipad . $s->_dump($v, $sname); |
|
671 - $out .= "," if $i++ < $#$val; |
|
672 + $sname = $mname . '[' . $i . ']'; |
|
673 + $out .= $pad . $ipad . '#' . $i |
|
674 + if $s->{indent} >= 3; |
|
675 + $out .= $pad . $ipad . $s->_dump($v, $sname); |
|
676 + $out .= "," if $i++ < $#$val; |
|
677 } |
|
678 $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i; |
|
679 $out .= ($name =~ /^\@/) ? ')' : ']'; |
|
680 } |
|
681 elsif ($realtype eq 'HASH') { |
|
682 - my($k, $v, $pad, $lpad, $mname, $pair); |
|
683 + my ($k, $v, $pad, $lpad, $mname, $pair); |
|
684 $out .= ($name =~ /^\%/) ? '(' : '{'; |
|
685 $pad = $s->{sep} . $s->{pad} . $s->{apad}; |
|
686 $lpad = $s->{apad}; |
|
687 $pair = $s->{pair}; |
|
688 ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : |
|
689 - # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} |
|
690 - ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : |
|
691 - ($mname = $name . '->'); |
|
692 + # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} |
|
693 + ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : |
|
694 + ($mname = $name . '->'); |
|
695 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; |
|
696 - my ($sortkeys, $keys, $key) = ("$s->{sortkeys}"); |
|
697 + my $sortkeys = defined($s->{sortkeys}) ? $s->{sortkeys} : ''; |
|
698 + my $keys = []; |
|
699 if ($sortkeys) { |
|
700 - if (ref($s->{sortkeys}) eq 'CODE') { |
|
701 - $keys = $s->{sortkeys}($val); |
|
702 - unless (ref($keys) eq 'ARRAY') { |
|
703 - carp "Sortkeys subroutine did not return ARRAYREF"; |
|
704 - $keys = []; |
|
705 - } |
|
706 - } |
|
707 - else { |
|
708 - $keys = [ sort keys %$val ]; |
|
709 - } |
|
710 + if (ref($s->{sortkeys}) eq 'CODE') { |
|
711 + $keys = $s->{sortkeys}($val); |
|
712 + unless (ref($keys) eq 'ARRAY') { |
|
713 + carp "Sortkeys subroutine did not return ARRAYREF"; |
|
714 + $keys = []; |
|
715 + } |
|
716 + } |
|
717 + else { |
|
718 + $keys = [ sort keys %$val ]; |
|
719 + } |
|
720 } |
|
721 |
|
722 # Ensure hash iterator is reset |
|
723 keys(%$val); |
|
724 |
|
725 + my $key; |
|
726 while (($k, $v) = ! $sortkeys ? (each %$val) : |
|
727 - @$keys ? ($key = shift(@$keys), $val->{$key}) : |
|
728 - () ) |
|
729 + @$keys ? ($key = shift(@$keys), $val->{$key}) : |
|
730 + () ) |
|
731 { |
|
732 - my $nk = $s->_dump($k, ""); |
|
733 - $nk = $1 if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/; |
|
734 - $sname = $mname . '{' . $nk . '}'; |
|
735 - $out .= $pad . $ipad . $nk . $pair; |
|
736 - |
|
737 - # temporarily alter apad |
|
738 - $s->{apad} .= (" " x (length($nk) + 4)) if $s->{indent} >= 2; |
|
739 - $out .= $s->_dump($val->{$k}, $sname) . ","; |
|
740 - $s->{apad} = $lpad if $s->{indent} >= 2; |
|
741 + my $nk = $s->_dump($k, ""); |
|
742 + |
|
743 + # _dump doesn't quote numbers of this form |
|
744 + if ($s->{quotekeys} && $nk =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { |
|
745 + $nk = $s->{useqq} ? qq("$nk") : qq('$nk'); |
|
746 + } |
|
747 + elsif (!$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/) { |
|
748 + $nk = $1 |
|
749 + } |
|
750 + |
|
751 + $sname = $mname . '{' . $nk . '}'; |
|
752 + $out .= $pad . $ipad . $nk . $pair; |
|
753 + |
|
754 + # temporarily alter apad |
|
755 + $s->{apad} .= (" " x (length($nk) + 4)) |
|
756 + if $s->{indent} >= 2; |
|
757 + $out .= $s->_dump($val->{$k}, $sname) . ","; |
|
758 + $s->{apad} = $lpad |
|
759 + if $s->{indent} >= 2; |
|
760 } |
|
761 if (substr($out, -1) eq ',') { |
|
762 - chop $out; |
|
763 - $out .= $pad . ($s->{xpad} x ($s->{level} - 1)); |
|
764 + chop $out; |
|
765 + $out .= $pad . ($s->{xpad} x ($s->{level} - 1)); |
|
766 } |
|
767 $out .= ($name =~ /^\%/) ? ')' : '}'; |
|
768 } |
|
769 elsif ($realtype eq 'CODE') { |
|
770 if ($s->{deparse}) { |
|
771 - require B::Deparse; |
|
772 - my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val); |
|
773 - $pad = $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1); |
|
774 - $sub =~ s/\n/$pad/gse; |
|
775 - $out .= $sub; |
|
776 - } else { |
|
777 + require B::Deparse; |
|
778 + my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val); |
|
779 + $pad = $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1); |
|
780 + $sub =~ s/\n/$pad/gse; |
|
781 + $out .= $sub; |
|
782 + } |
|
783 + else { |
|
784 $out .= 'sub { "DUMMY" }'; |
|
785 carp "Encountered CODE ref, using dummy placeholder" if $s->{purity}; |
|
786 } |
|
787 } |
|
788 else { |
|
789 - croak "Can\'t handle $realtype type."; |
|
790 + croak "Can't handle '$realtype' type"; |
|
791 } |
|
792 - |
|
793 + |
|
794 if ($realpack and !$no_bless) { # we have a blessed ref |
|
795 $out .= ', ' . _quote($realpack) . ' )'; |
|
796 - $out .= '->' . $s->{toaster} . '()' if $s->{toaster} ne ''; |
|
797 + $out .= '->' . $s->{toaster} . '()' |
|
798 + if $s->{toaster} ne ''; |
|
799 $s->{apad} = $blesspad; |
|
800 } |
|
801 $s->{level}--; |
|
802 - |
|
803 } |
|
804 else { # simple scalar |
|
805 |
|
806 my $ref = \$_[1]; |
|
807 + my $v; |
|
808 # first, catalog the scalar |
|
809 if ($name ne '') { |
|
810 $id = format_refaddr($ref); |
|
811 if (exists $s->{seen}{$id}) { |
|
812 if ($s->{seen}{$id}[2]) { |
|
813 - $out = $s->{seen}{$id}[0]; |
|
814 - #warn "[<$out]\n"; |
|
815 - return "\${$out}"; |
|
816 - } |
|
817 + $out = $s->{seen}{$id}[0]; |
|
818 + #warn "[<$out]\n"; |
|
819 + return "\${$out}"; |
|
820 + } |
|
821 } |
|
822 else { |
|
823 - #warn "[>\\$name]\n"; |
|
824 - $s->{seen}{$id} = ["\\$name", $ref]; |
|
825 + #warn "[>\\$name]\n"; |
|
826 + $s->{seen}{$id} = ["\\$name", $ref]; |
|
827 } |
|
828 } |
|
829 - if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob |
|
830 + $ref = \$val; |
|
831 + if (ref($ref) eq 'GLOB') { # glob |
|
832 my $name = substr($val, 1); |
|
833 - if ($name =~ /^[A-Za-z_][\w:]*$/) { |
|
834 - $name =~ s/^main::/::/; |
|
835 - $sname = $name; |
|
836 + if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') { |
|
837 + $name =~ s/^main::/::/; |
|
838 + $sname = $name; |
|
839 } |
|
840 else { |
|
841 - $sname = $s->_dump($name, ""); |
|
842 - $sname = '{' . $sname . '}'; |
|
843 + $sname = $s->_dump( |
|
844 + $name eq 'main::' || $] < 5.007 && $name eq "main::\0" |
|
845 + ? '' |
|
846 + : $name, |
|
847 + "", |
|
848 + ); |
|
849 + $sname = '{' . $sname . '}'; |
|
850 } |
|
851 if ($s->{purity}) { |
|
852 - my $k; |
|
853 - local ($s->{level}) = 0; |
|
854 - for $k (qw(SCALAR ARRAY HASH)) { |
|
855 - my $gval = *$val{$k}; |
|
856 - next unless defined $gval; |
|
857 - next if $k eq "SCALAR" && ! defined $$gval; # always there |
|
858 - |
|
859 - # _dump can push into @post, so we hold our place using $postlen |
|
860 - my $postlen = scalar @post; |
|
861 - $post[$postlen] = "\*$sname = "; |
|
862 - local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2; |
|
863 - $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}"); |
|
864 - } |
|
865 + my $k; |
|
866 + local ($s->{level}) = 0; |
|
867 + for $k (qw(SCALAR ARRAY HASH)) { |
|
868 + my $gval = *$val{$k}; |
|
869 + next unless defined $gval; |
|
870 + next if $k eq "SCALAR" && ! defined $$gval; # always there |
|
871 + |
|
872 + # _dump can push into @post, so we hold our place using $postlen |
|
873 + my $postlen = scalar @post; |
|
874 + $post[$postlen] = "\*$sname = "; |
|
875 + local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2; |
|
876 + $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}"); |
|
877 + } |
|
878 } |
|
879 $out .= '*' . $sname; |
|
880 } |
|
881 elsif (!defined($val)) { |
|
882 $out .= "undef"; |
|
883 } |
|
884 - elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number |
|
885 + elsif (defined &_vstring and $v = _vstring($val) |
|
886 + and !_bad_vsmg || eval $v eq $val) { |
|
887 + $out .= $v; |
|
888 + } |
|
889 + elsif (!defined &_vstring |
|
890 + and ref $ref eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) { |
|
891 + $out .= sprintf "%vd", $val; |
|
892 + } |
|
893 + # \d here would treat "1\x{660}" as a safe decimal number |
|
894 + elsif ($val =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { # safe decimal number |
|
895 $out .= $val; |
|
896 } |
|
897 - else { # string |
|
898 + else { # string |
|
899 if ($s->{useqq} or $val =~ tr/\0-\377//c) { |
|
900 # Fall back to qq if there's Unicode |
|
901 - $out .= qquote($val, $s->{useqq}); |
|
902 + $out .= qquote($val, $s->{useqq}); |
|
903 } |
|
904 else { |
|
905 $out .= _quote($val); |
|
906 @@ -545,7 +587,7 @@ |
|
907 } |
|
908 return $out; |
|
909 } |
|
910 - |
|
911 + |
|
912 # |
|
913 # non-OO style of earlier version |
|
914 # |
|
915 @@ -558,12 +600,8 @@ |
|
916 return Data::Dumper->Dumpxs([@_], []); |
|
917 } |
|
918 |
|
919 -sub Dumpf { return Data::Dumper->Dump(@_) } |
|
920 - |
|
921 -sub Dumpp { print Data::Dumper->Dump(@_) } |
|
922 - |
|
923 # |
|
924 -# reset the "seen" cache |
|
925 +# reset the "seen" cache |
|
926 # |
|
927 sub Reset { |
|
928 my($s) = shift; |
|
929 @@ -650,6 +688,11 @@ |
|
930 defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'}; |
|
931 } |
|
932 |
|
933 +sub Maxrecurse { |
|
934 + my($s, $v) = @_; |
|
935 + defined($v) ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'}; |
|
936 +} |
|
937 + |
|
938 sub Useperl { |
|
939 my($s, $v) = @_; |
|
940 defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'}; |
|
941 @@ -665,8 +708,13 @@ |
|
942 defined($v) ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'}; |
|
943 } |
|
944 |
|
945 +sub Sparseseen { |
|
946 + my($s, $v) = @_; |
|
947 + defined($v) ? (($s->{'noseen'} = $v), return $s) : $s->{'noseen'}; |
|
948 +} |
|
949 + |
|
950 # used by qquote below |
|
951 -my %esc = ( |
|
952 +my %esc = ( |
|
953 "\a" => "\\a", |
|
954 "\b" => "\\b", |
|
955 "\t" => "\\t", |
|
956 @@ -681,8 +729,8 @@ |
|
957 local($_) = shift; |
|
958 s/([\\\"\@\$])/\\$1/g; |
|
959 my $bytes; { use bytes; $bytes = length } |
|
960 - s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length; |
|
961 - return qq("$_") unless |
|
962 + s/([[:^ascii:]])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length; |
|
963 + return qq("$_") unless |
|
964 /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/; # fast exit |
|
965 |
|
966 my $high = shift || ""; |
|
967 @@ -719,6 +767,45 @@ |
|
968 # access to sortsv() from XS |
|
969 sub _sortkeys { [ sort keys %{$_[0]} ] } |
|
970 |
|
971 +sub _refine_name { |
|
972 + my $s = shift; |
|
973 + my ($name, $val, $i) = @_; |
|
974 + if (defined $name) { |
|
975 + if ($name =~ /^[*](.*)$/) { |
|
976 + if (defined $val) { |
|
977 + $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) : |
|
978 + (ref $val eq 'HASH') ? ( "\%" . $1 ) : |
|
979 + (ref $val eq 'CODE') ? ( "\*" . $1 ) : |
|
980 + ( "\$" . $1 ) ; |
|
981 + } |
|
982 + else { |
|
983 + $name = "\$" . $1; |
|
984 + } |
|
985 + } |
|
986 + elsif ($name !~ /^\$/) { |
|
987 + $name = "\$" . $name; |
|
988 + } |
|
989 + } |
|
990 + else { # no names provided |
|
991 + $name = "\$" . $s->{varname} . $i; |
|
992 + } |
|
993 + return $name; |
|
994 +} |
|
995 + |
|
996 +sub _compose_out { |
|
997 + my $s = shift; |
|
998 + my ($valstr, $postref) = @_; |
|
999 + my $out = ""; |
|
1000 + $out .= $s->{pad} . $valstr . $s->{sep}; |
|
1001 + if (@{$postref}) { |
|
1002 + $out .= $s->{pad} . |
|
1003 + join(';' . $s->{sep} . $s->{pad}, @{$postref}) . |
|
1004 + ';' . |
|
1005 + $s->{sep}; |
|
1006 + } |
|
1007 + return $out; |
|
1008 +} |
|
1009 + |
|
1010 1; |
|
1011 __END__ |
|
1012 |
|
1013 @@ -759,7 +846,8 @@ |
|
1014 structures correctly. |
|
1015 |
|
1016 The return value can be C<eval>ed to get back an identical copy of the |
|
1017 -original reference structure. |
|
1018 +original reference structure. (Please do consider the security implications |
|
1019 +of eval'ing code from untrusted sources!) |
|
1020 |
|
1021 Any references that are the same as one of those passed in will be named |
|
1022 C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references |
|
1023 @@ -777,7 +865,7 @@ |
|
1024 you need to ensure that any variables it accesses are previously declared. |
|
1025 |
|
1026 In the extended usage form, the references to be dumped can be given |
|
1027 -user-specified names. If a name begins with a C<*>, the output will |
|
1028 +user-specified names. If a name begins with a C<*>, the output will |
|
1029 describe the dereferenced type of the supplied reference for hashes and |
|
1030 arrays, and coderefs. Output of names will be avoided where possible if |
|
1031 the C<Terse> flag is set. |
|
1032 @@ -787,7 +875,7 @@ |
|
1033 chained together. |
|
1034 |
|
1035 Several styles of output are possible, all controlled by setting |
|
1036 -the C<Indent> flag. See L<Configuration Variables or Methods> below |
|
1037 +the C<Indent> flag. See L<Configuration Variables or Methods> below |
|
1038 for details. |
|
1039 |
|
1040 |
|
1041 @@ -839,15 +927,21 @@ |
|
1042 |
|
1043 =item I<$OBJ>->Values(I<[ARRAYREF]>) |
|
1044 |
|
1045 -Queries or replaces the internal array of values that will be dumped. |
|
1046 -When called without arguments, returns the values. Otherwise, returns the |
|
1047 -object itself. |
|
1048 +Queries or replaces the internal array of values that will be dumped. When |
|
1049 +called without arguments, returns the values as a list. When called with a |
|
1050 +reference to an array of replacement values, returns the object itself. When |
|
1051 +called with any other type of argument, dies. |
|
1052 |
|
1053 =item I<$OBJ>->Names(I<[ARRAYREF]>) |
|
1054 |
|
1055 Queries or replaces the internal array of user supplied names for the values |
|
1056 -that will be dumped. When called without arguments, returns the names. |
|
1057 -Otherwise, returns the object itself. |
|
1058 +that will be dumped. When called without arguments, returns the names. When |
|
1059 +called with an array of replacement names, returns the object itself. If the |
|
1060 +number of replacement names exceeds the number of values to be named, the |
|
1061 +excess names will not be used. If the number of replacement names falls short |
|
1062 +of the number of values to be named, the list of replacement names will be |
|
1063 +exhausted and remaining values will not be renamed. When |
|
1064 +called with any other type of argument, dies. |
|
1065 |
|
1066 =item I<$OBJ>->Reset |
|
1067 |
|
1068 @@ -874,7 +968,7 @@ |
|
1069 Several configuration variables can be used to control the kind of output |
|
1070 generated when using the procedural interface. These variables are usually |
|
1071 C<local>ized in a block so that other parts of the code are not affected by |
|
1072 -the change. |
|
1073 +the change. |
|
1074 |
|
1075 These variables determine the default state of the object created by calling |
|
1076 the C<new> method, but cannot be used to alter the state of the object |
|
1077 @@ -987,7 +1081,7 @@ |
|
1078 $Data::Dumper::Quotekeys I<or> $I<OBJ>->Quotekeys(I<[NEWVAL]>) |
|
1079 |
|
1080 Can be set to a boolean value to control whether hash keys are quoted. |
|
1081 -A false value will avoid quoting hash keys when it looks like a simple |
|
1082 +A defined false value will avoid quoting hash keys when it looks like a simple |
|
1083 string. Default is 1, which will always enclose hash keys in quotes. |
|
1084 |
|
1085 =item * |
|
1086 @@ -1019,8 +1113,18 @@ |
|
1087 Can be set to a positive integer that specifies the depth beyond which |
|
1088 we don't venture into a structure. Has no effect when |
|
1089 C<Data::Dumper::Purity> is set. (Useful in debugger when we often don't |
|
1090 -want to see more than enough). Default is 0, which means there is |
|
1091 -no maximum depth. |
|
1092 +want to see more than enough). Default is 0, which means there is |
|
1093 +no maximum depth. |
|
1094 + |
|
1095 +=item * |
|
1096 + |
|
1097 +$Data::Dumper::Maxrecurse I<or> $I<OBJ>->Maxrecurse(I<[NEWVAL]>) |
|
1098 + |
|
1099 +Can be set to a positive integer that specifies the depth beyond which |
|
1100 +recursion into a structure will throw an exception. This is intended |
|
1101 +as a security measure to prevent perl running out of stack space when |
|
1102 +dumping an excessively deep structure. Can be set to 0 to remove the |
|
1103 +limit. Default is 1000. |
|
1104 |
|
1105 =item * |
|
1106 |
|
1107 @@ -1064,6 +1168,26 @@ |
|
1108 Caution : use this option only if you know that your coderefs will be |
|
1109 properly reconstructed by C<B::Deparse>. |
|
1110 |
|
1111 +=item * |
|
1112 + |
|
1113 +$Data::Dumper::Sparseseen I<or> $I<OBJ>->Sparseseen(I<[NEWVAL]>) |
|
1114 + |
|
1115 +By default, Data::Dumper builds up the "seen" hash of scalars that |
|
1116 +it has encountered during serialization. This is very expensive. |
|
1117 +This seen hash is necessary to support and even just detect circular |
|
1118 +references. It is exposed to the user via the C<Seen()> call both |
|
1119 +for writing and reading. |
|
1120 + |
|
1121 +If you, as a user, do not need explicit access to the "seen" hash, |
|
1122 +then you can set the C<Sparseseen> option to allow Data::Dumper |
|
1123 +to eschew building the "seen" hash for scalars that are known not |
|
1124 +to possess more than one reference. This speeds up serialization |
|
1125 +considerably if you use the XS implementation. |
|
1126 + |
|
1127 +Note: If you turn on C<Sparseseen>, then you must not rely on the |
|
1128 +content of the seen hash since its contents will be an |
|
1129 +implementation detail! |
|
1130 + |
|
1131 =back |
|
1132 |
|
1133 =head2 Exports |
|
1134 @@ -1095,7 +1219,7 @@ |
|
1135 $foo = Foo->new; |
|
1136 $fuz = Fuz->new; |
|
1137 $boo = [ 1, [], "abcd", \*foo, |
|
1138 - {1 => 'a', 023 => 'b', 0x45 => 'c'}, |
|
1139 + {1 => 'a', 023 => 'b', 0x45 => 'c'}, |
|
1140 \\"p\q\'r", $foo, $fuz]; |
|
1141 |
|
1142 ######## |
|
1143 @@ -1106,20 +1230,20 @@ |
|
1144 print($@) if $@; |
|
1145 print Dumper($boo), Dumper($bar); # pretty print (no array indices) |
|
1146 |
|
1147 - $Data::Dumper::Terse = 1; # don't output names where feasible |
|
1148 - $Data::Dumper::Indent = 0; # turn off all pretty print |
|
1149 + $Data::Dumper::Terse = 1; # don't output names where feasible |
|
1150 + $Data::Dumper::Indent = 0; # turn off all pretty print |
|
1151 print Dumper($boo), "\n"; |
|
1152 |
|
1153 - $Data::Dumper::Indent = 1; # mild pretty print |
|
1154 + $Data::Dumper::Indent = 1; # mild pretty print |
|
1155 print Dumper($boo); |
|
1156 |
|
1157 - $Data::Dumper::Indent = 3; # pretty print with array indices |
|
1158 + $Data::Dumper::Indent = 3; # pretty print with array indices |
|
1159 print Dumper($boo); |
|
1160 |
|
1161 - $Data::Dumper::Useqq = 1; # print strings in double quotes |
|
1162 + $Data::Dumper::Useqq = 1; # print strings in double quotes |
|
1163 print Dumper($boo); |
|
1164 |
|
1165 - $Data::Dumper::Pair = " : "; # specify hash key/value separator |
|
1166 + $Data::Dumper::Pair = " : "; # specify hash key/value separator |
|
1167 print Dumper($boo); |
|
1168 |
|
1169 |
|
1170 @@ -1185,20 +1309,20 @@ |
|
1171 sub new { bless { state => 'awake' }, shift } |
|
1172 sub Freeze { |
|
1173 my $s = shift; |
|
1174 - print STDERR "preparing to sleep\n"; |
|
1175 - $s->{state} = 'asleep'; |
|
1176 - return bless $s, 'Foo::ZZZ'; |
|
1177 + print STDERR "preparing to sleep\n"; |
|
1178 + $s->{state} = 'asleep'; |
|
1179 + return bless $s, 'Foo::ZZZ'; |
|
1180 } |
|
1181 |
|
1182 package Foo::ZZZ; |
|
1183 sub Thaw { |
|
1184 my $s = shift; |
|
1185 - print STDERR "waking up\n"; |
|
1186 - $s->{state} = 'awake'; |
|
1187 - return bless $s, 'Foo'; |
|
1188 + print STDERR "waking up\n"; |
|
1189 + $s->{state} = 'awake'; |
|
1190 + return bless $s, 'Foo'; |
|
1191 } |
|
1192 |
|
1193 - package Foo; |
|
1194 + package main; |
|
1195 use Data::Dumper; |
|
1196 $a = Foo->new; |
|
1197 $b = Data::Dumper->new([$a], ['c']); |
|
1198 @@ -1291,13 +1415,13 @@ |
|
1199 |
|
1200 Gurusamy Sarathy [email protected] |
|
1201 |
|
1202 -Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved. |
|
1203 +Copyright (c) 1996-2014 Gurusamy Sarathy. All rights reserved. |
|
1204 This program is free software; you can redistribute it and/or |
|
1205 modify it under the same terms as Perl itself. |
|
1206 |
|
1207 =head1 VERSION |
|
1208 |
|
1209 -Version 2.125 (Aug 8 2009) |
|
1210 +Version 2.154 (September 18 2014) |
|
1211 |
|
1212 =head1 SEE ALSO |
|
1213 |
|
1214 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/Dumper.xs perl-5.12.5_dumper/dist/Data-Dumper/Dumper.xs |
|
1215 --- perl-5.12.5/dist/Data-Dumper/Dumper.xs 2012-11-03 19:25:59.000000000 -0400 |
|
1216 +++ perl-5.12.5_dumper/dist/Data-Dumper/Dumper.xs 2014-10-09 15:06:36.168048722 -0400 |
|
1217 @@ -12,22 +12,32 @@ |
|
1218 # define DD_USE_OLD_ID_FORMAT |
|
1219 #endif |
|
1220 |
|
1221 +#ifndef isWORDCHAR |
|
1222 +# define isWORDCHAR(c) isALNUM(c) |
|
1223 +#endif |
|
1224 + |
|
1225 static I32 num_q (const char *s, STRLEN slen); |
|
1226 static I32 esc_q (char *dest, const char *src, STRLEN slen); |
|
1227 -static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen); |
|
1228 -static I32 needs_quote(register const char *s); |
|
1229 +static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq); |
|
1230 +static bool globname_needs_quote(const char *s, STRLEN len); |
|
1231 +static bool key_needs_quote(const char *s, STRLEN len); |
|
1232 +static bool safe_decimal_number(const char *p, STRLEN len); |
|
1233 static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n); |
|
1234 static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, |
|
1235 HV *seenhv, AV *postav, I32 *levelp, I32 indent, |
|
1236 SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair, |
|
1237 SV *freezer, SV *toaster, |
|
1238 I32 purity, I32 deepcopy, I32 quotekeys, SV *bless, |
|
1239 - I32 maxdepth, SV *sortkeys); |
|
1240 + I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash, I32 useqq, IV maxrecurse); |
|
1241 |
|
1242 #ifndef HvNAME_get |
|
1243 #define HvNAME_get HvNAME |
|
1244 #endif |
|
1245 |
|
1246 +/* Perls 7 through portions of 15 used utf8_to_uvchr() which didn't have a |
|
1247 + * length parameter. This wrongly allowed reading beyond the end of buffer |
|
1248 + * given malformed input */ |
|
1249 + |
|
1250 #if PERL_VERSION <= 6 /* Perl 5.6 and earlier */ |
|
1251 |
|
1252 # ifdef EBCDIC |
|
1253 @@ -37,21 +47,43 @@ |
|
1254 # endif |
|
1255 |
|
1256 UV |
|
1257 -Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen) |
|
1258 +Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen) |
|
1259 { |
|
1260 - const UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen, |
|
1261 + const UV uv = utf8_to_uv(s, send - s, retlen, |
|
1262 ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); |
|
1263 return UNI_TO_NATIVE(uv); |
|
1264 } |
|
1265 |
|
1266 # if !defined(PERL_IMPLICIT_CONTEXT) |
|
1267 -# define utf8_to_uvchr Perl_utf8_to_uvchr |
|
1268 +# define utf8_to_uvchr_buf Perl_utf8_to_uvchr_buf |
|
1269 # else |
|
1270 -# define utf8_to_uvchr(a,b) Perl_utf8_to_uvchr(aTHX_ a,b) |
|
1271 +# define utf8_to_uvchr_buf(a,b,c) Perl_utf8_to_uvchr_buf(aTHX_ a,b,c) |
|
1272 # endif |
|
1273 |
|
1274 #endif /* PERL_VERSION <= 6 */ |
|
1275 |
|
1276 +/* Perl 5.7 through part of 5.15 */ |
|
1277 +#if PERL_VERSION > 6 && PERL_VERSION <= 15 && ! defined(utf8_to_uvchr_buf) |
|
1278 + |
|
1279 +UV |
|
1280 +Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen) |
|
1281 +{ |
|
1282 + /* We have to discard <send> for these versions; hence can read off the |
|
1283 + * end of the buffer if there is a malformation that indicates the |
|
1284 + * character is longer than the space available */ |
|
1285 + |
|
1286 + const UV uv = utf8_to_uvchr(s, retlen); |
|
1287 + return UNI_TO_NATIVE(uv); |
|
1288 +} |
|
1289 + |
|
1290 +# if !defined(PERL_IMPLICIT_CONTEXT) |
|
1291 +# define utf8_to_uvchr_buf Perl_utf8_to_uvchr_buf |
|
1292 +# else |
|
1293 +# define utf8_to_uvchr_buf(a,b,c) Perl_utf8_to_uvchr_buf(aTHX_ a,b,c) |
|
1294 +# endif |
|
1295 + |
|
1296 +#endif /* PERL_VERSION > 6 && <= 15 */ |
|
1297 + |
|
1298 /* Changes in 5.7 series mean that now IOK is only set if scalar is |
|
1299 precisely integer but in 5.6 and earlier we need to do a more |
|
1300 complex test */ |
|
1301 @@ -61,38 +93,95 @@ |
|
1302 #define DD_is_integer(sv) SvIOK(sv) |
|
1303 #endif |
|
1304 |
|
1305 -/* does a string need to be protected? */ |
|
1306 -static I32 |
|
1307 -needs_quote(register const char *s) |
|
1308 +/* does a glob name need to be protected? */ |
|
1309 +static bool |
|
1310 +globname_needs_quote(const char *s, STRLEN len) |
|
1311 { |
|
1312 + const char *send = s+len; |
|
1313 TOP: |
|
1314 if (s[0] == ':') { |
|
1315 - if (*++s) { |
|
1316 + if (++s<send) { |
|
1317 if (*s++ != ':') |
|
1318 - return 1; |
|
1319 + return TRUE; |
|
1320 } |
|
1321 else |
|
1322 - return 1; |
|
1323 + return TRUE; |
|
1324 } |
|
1325 if (isIDFIRST(*s)) { |
|
1326 - while (*++s) |
|
1327 - if (!isALNUM(*s)) { |
|
1328 + while (++s<send) |
|
1329 + if (!isWORDCHAR(*s)) { |
|
1330 if (*s == ':') |
|
1331 goto TOP; |
|
1332 else |
|
1333 - return 1; |
|
1334 + return TRUE; |
|
1335 } |
|
1336 } |
|
1337 else |
|
1338 - return 1; |
|
1339 - return 0; |
|
1340 + return TRUE; |
|
1341 + |
|
1342 + return FALSE; |
|
1343 +} |
|
1344 + |
|
1345 +/* does a hash key need to be quoted (to the left of => ). |
|
1346 + Previously this used (globname_)needs_quote() which accepted strings |
|
1347 + like '::foo', but these aren't safe as unquoted keys under strict. |
|
1348 +*/ |
|
1349 +static bool |
|
1350 +key_needs_quote(const char *s, STRLEN len) { |
|
1351 + const char *send = s+len; |
|
1352 + |
|
1353 + if (safe_decimal_number(s, len)) { |
|
1354 + return FALSE; |
|
1355 + } |
|
1356 + else if (isIDFIRST(*s)) { |
|
1357 + while (++s<send) |
|
1358 + if (!isWORDCHAR(*s)) |
|
1359 + return TRUE; |
|
1360 + } |
|
1361 + else |
|
1362 + return TRUE; |
|
1363 + |
|
1364 + return FALSE; |
|
1365 +} |
|
1366 + |
|
1367 +/* Check that the SV can be represented as a simple decimal integer. |
|
1368 + * |
|
1369 + * The perl code does this by matching against /^(?:0|-?[1-9]\d{0,8})\z/ |
|
1370 +*/ |
|
1371 +static bool |
|
1372 +safe_decimal_number(const char *p, STRLEN len) { |
|
1373 + if (len == 1 && *p == '0') |
|
1374 + return TRUE; |
|
1375 + |
|
1376 + if (len && *p == '-') { |
|
1377 + ++p; |
|
1378 + --len; |
|
1379 + } |
|
1380 + |
|
1381 + if (len == 0 || *p < '1' || *p > '9') |
|
1382 + return FALSE; |
|
1383 + |
|
1384 + ++p; |
|
1385 + --len; |
|
1386 + |
|
1387 + if (len > 8) |
|
1388 + return FALSE; |
|
1389 + |
|
1390 + while (len > 0) { |
|
1391 + /* the perl code checks /\d/ but we don't want unicode digits here */ |
|
1392 + if (*p < '0' || *p > '9') |
|
1393 + return FALSE; |
|
1394 + ++p; |
|
1395 + --len; |
|
1396 + } |
|
1397 + return TRUE; |
|
1398 } |
|
1399 |
|
1400 /* count the number of "'"s and "\"s in string */ |
|
1401 static I32 |
|
1402 -num_q(register const char *s, register STRLEN slen) |
|
1403 +num_q(const char *s, STRLEN slen) |
|
1404 { |
|
1405 - register I32 ret = 0; |
|
1406 + I32 ret = 0; |
|
1407 |
|
1408 while (slen > 0) { |
|
1409 if (*s == '\'' || *s == '\\') |
|
1410 @@ -108,9 +197,9 @@ |
|
1411 /* slen number of characters in s will be escaped */ |
|
1412 /* destination must be long enough for additional chars */ |
|
1413 static I32 |
|
1414 -esc_q(register char *d, register const char *s, register STRLEN slen) |
|
1415 +esc_q(char *d, const char *s, STRLEN slen) |
|
1416 { |
|
1417 - register I32 ret = 0; |
|
1418 + I32 ret = 0; |
|
1419 |
|
1420 while (slen > 0) { |
|
1421 switch (*s) { |
|
1422 @@ -118,6 +207,7 @@ |
|
1423 case '\\': |
|
1424 *d = '\\'; |
|
1425 ++d; ++ret; |
|
1426 + /* FALLTHROUGH */ |
|
1427 default: |
|
1428 *d = *s; |
|
1429 ++d; ++s; --slen; |
|
1430 @@ -127,8 +217,9 @@ |
|
1431 return ret; |
|
1432 } |
|
1433 |
|
1434 +/* this function is also misused for implementing $Useqq */ |
|
1435 static I32 |
|
1436 -esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen) |
|
1437 +esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq) |
|
1438 { |
|
1439 char *r, *rstart; |
|
1440 const char *s = src; |
|
1441 @@ -142,10 +233,21 @@ |
|
1442 STRLEN single_quotes = 0; |
|
1443 STRLEN qq_escapables = 0; /* " $ @ will need a \ in "" strings. */ |
|
1444 STRLEN normal = 0; |
|
1445 + int increment; |
|
1446 + UV next; |
|
1447 |
|
1448 /* this will need EBCDICification */ |
|
1449 - for (s = src; s < send; s += UTF8SKIP(s)) { |
|
1450 - const UV k = utf8_to_uvchr((U8*)s, NULL); |
|
1451 + for (s = src; s < send; do_utf8 ? s += increment : s++) { |
|
1452 + const UV k = do_utf8 ? utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL) : *(U8*)s; |
|
1453 + |
|
1454 + /* check for invalid utf8 */ |
|
1455 + increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s); |
|
1456 + |
|
1457 + /* this is only used to check if the next character is an |
|
1458 + * ASCII digit, which are invariant, so if the following collects |
|
1459 + * a UTF-8 start byte it does no harm |
|
1460 + */ |
|
1461 + next = (s + increment >= send ) ? 0 : *(U8*)(s+increment); |
|
1462 |
|
1463 #ifdef EBCDIC |
|
1464 if (!isprint(k) || k > 256) { |
|
1465 @@ -160,6 +262,17 @@ |
|
1466 k <= 0xFFFFFFFF ? 8 : UVSIZE * 4 |
|
1467 #endif |
|
1468 ); |
|
1469 +#ifndef EBCDIC |
|
1470 + } else if (useqq && |
|
1471 + /* we can't use the short form like '\0' if followed by a digit */ |
|
1472 + (((k >= 7 && k <= 10) || k == 12 || k == 13 || k == 27) |
|
1473 + || (k < 8 && (next < '0' || next > '9')))) { |
|
1474 + grow += 2; |
|
1475 + } else if (useqq && k <= 31 && (next < '0' || next > '9')) { |
|
1476 + grow += 3; |
|
1477 + } else if (useqq && (k <= 31 || k >= 127)) { |
|
1478 + grow += 4; |
|
1479 +#endif |
|
1480 } else if (k == '\\') { |
|
1481 backslashes++; |
|
1482 } else if (k == '\'') { |
|
1483 @@ -170,7 +283,7 @@ |
|
1484 normal++; |
|
1485 } |
|
1486 } |
|
1487 - if (grow) { |
|
1488 + if (grow || useqq) { |
|
1489 /* We have something needing hex. 3 is ""\0 */ |
|
1490 sv_grow(sv, cur + 3 + grow + 2*backslashes + single_quotes |
|
1491 + 2*qq_escapables + normal); |
|
1492 @@ -178,8 +291,8 @@ |
|
1493 |
|
1494 *r++ = '"'; |
|
1495 |
|
1496 - for (s = src; s < send; s += UTF8SKIP(s)) { |
|
1497 - const UV k = utf8_to_uvchr((U8*)s, NULL); |
|
1498 + for (s = src; s < send; do_utf8 ? s += UTF8SKIP(s) : s++) { |
|
1499 + const UV k = do_utf8 ? utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL) : *(U8*)s; |
|
1500 |
|
1501 if (k == '"' || k == '\\' || k == '$' || k == '@') { |
|
1502 *r++ = '\\'; |
|
1503 @@ -189,7 +302,44 @@ |
|
1504 #ifdef EBCDIC |
|
1505 if (isprint(k) && k < 256) |
|
1506 #else |
|
1507 - if (k < 0x80) |
|
1508 + if (useqq && (k <= 31 || k == 127 || (!do_utf8 && k > 127))) { |
|
1509 + bool next_is_digit; |
|
1510 + |
|
1511 + *r++ = '\\'; |
|
1512 + switch (k) { |
|
1513 + case 7: *r++ = 'a'; break; |
|
1514 + case 8: *r++ = 'b'; break; |
|
1515 + case 9: *r++ = 't'; break; |
|
1516 + case 10: *r++ = 'n'; break; |
|
1517 + case 12: *r++ = 'f'; break; |
|
1518 + case 13: *r++ = 'r'; break; |
|
1519 + case 27: *r++ = 'e'; break; |
|
1520 + default: |
|
1521 + increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s); |
|
1522 + |
|
1523 + /* only ASCII digits matter here, which are invariant, |
|
1524 + * since we only encode characters \377 and under, or |
|
1525 + * \x177 and under for a unicode string |
|
1526 + */ |
|
1527 + next = (s+increment < send) ? *(U8*)(s+increment) : 0; |
|
1528 + next_is_digit = next >= '0' && next <= '9'; |
|
1529 + |
|
1530 + /* faster than |
|
1531 + * r = r + my_sprintf(r, "%o", k); |
|
1532 + */ |
|
1533 + if (k <= 7 && !next_is_digit) { |
|
1534 + *r++ = (char)k + '0'; |
|
1535 + } else if (k <= 63 && !next_is_digit) { |
|
1536 + *r++ = (char)(k>>3) + '0'; |
|
1537 + *r++ = (char)(k&7) + '0'; |
|
1538 + } else { |
|
1539 + *r++ = (char)(k>>6) + '0'; |
|
1540 + *r++ = (char)((k&63)>>3) + '0'; |
|
1541 + *r++ = (char)(k&7) + '0'; |
|
1542 + } |
|
1543 + } |
|
1544 + } |
|
1545 + else if (k < 0x80) |
|
1546 #endif |
|
1547 *r++ = (char)k; |
|
1548 else { |
|
1549 @@ -229,7 +379,7 @@ |
|
1550 sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n) |
|
1551 { |
|
1552 if (!sv) |
|
1553 - sv = newSVpvn("", 0); |
|
1554 + sv = newSVpvs(""); |
|
1555 #ifdef DEBUGGING |
|
1556 else |
|
1557 assert(SvTYPE(sv) >= SVt_PV); |
|
1558 @@ -262,10 +412,11 @@ |
|
1559 DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, |
|
1560 AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad, |
|
1561 SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity, |
|
1562 - I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys) |
|
1563 + I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys, |
|
1564 + int use_sparse_seen_hash, I32 useqq, IV maxrecurse) |
|
1565 { |
|
1566 char tmpbuf[128]; |
|
1567 - U32 i; |
|
1568 + Size_t i; |
|
1569 char *c, *r, *realpack; |
|
1570 #ifdef DD_USE_OLD_ID_FORMAT |
|
1571 char id[128]; |
|
1572 @@ -289,7 +440,7 @@ |
|
1573 if (!val) |
|
1574 return 0; |
|
1575 |
|
1576 - /* If the ouput buffer has less than some arbitary amount of space |
|
1577 + /* If the ouput buffer has less than some arbitrary amount of space |
|
1578 remaining, then enlarge it. For the test case (25M of output), |
|
1579 *1.1 was slower, *2.0 was the same, so the first guess of 1.5 is |
|
1580 deemed to be good enough. */ |
|
1581 @@ -312,7 +463,7 @@ |
|
1582 { |
|
1583 dSP; ENTER; SAVETMPS; PUSHMARK(sp); |
|
1584 XPUSHs(val); PUTBACK; |
|
1585 - i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID); |
|
1586 + i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID|G_DISCARD); |
|
1587 SPAGAIN; |
|
1588 if (SvTRUE(ERRSV)) |
|
1589 warn("WARNING(Freezer method call failed): %"SVf"", ERRSV); |
|
1590 @@ -347,13 +498,13 @@ |
|
1591 SV *postentry; |
|
1592 |
|
1593 if (realtype == SVt_PVHV) |
|
1594 - sv_catpvn(retval, "{}", 2); |
|
1595 + sv_catpvs(retval, "{}"); |
|
1596 else if (realtype == SVt_PVAV) |
|
1597 - sv_catpvn(retval, "[]", 2); |
|
1598 + sv_catpvs(retval, "[]"); |
|
1599 else |
|
1600 - sv_catpvn(retval, "do{my $o}", 9); |
|
1601 + sv_catpvs(retval, "do{my $o}"); |
|
1602 postentry = newSVpvn(name, namelen); |
|
1603 - sv_catpvn(postentry, " = ", 3); |
|
1604 + sv_catpvs(postentry, " = "); |
|
1605 sv_catsv(postentry, othername); |
|
1606 av_push(postav, postentry); |
|
1607 } |
|
1608 @@ -366,9 +517,9 @@ |
|
1609 } |
|
1610 else { |
|
1611 sv_catpvn(retval, name, 1); |
|
1612 - sv_catpvn(retval, "{", 1); |
|
1613 + sv_catpvs(retval, "{"); |
|
1614 sv_catsv(retval, othername); |
|
1615 - sv_catpvn(retval, "}", 1); |
|
1616 + sv_catpvs(retval, "}"); |
|
1617 } |
|
1618 } |
|
1619 else |
|
1620 @@ -388,11 +539,11 @@ |
|
1621 else { /* store our name and continue */ |
|
1622 SV *namesv; |
|
1623 if (name[0] == '@' || name[0] == '%') { |
|
1624 - namesv = newSVpvn("\\", 1); |
|
1625 + namesv = newSVpvs("\\"); |
|
1626 sv_catpvn(namesv, name, namelen); |
|
1627 } |
|
1628 else if (realtype == SVt_PVCV && name[0] == '*') { |
|
1629 - namesv = newSVpvn("\\", 2); |
|
1630 + namesv = newSVpvs("\\"); |
|
1631 sv_catpvn(namesv, name, namelen); |
|
1632 (SvPVX(namesv))[1] = '&'; |
|
1633 } |
|
1634 @@ -433,17 +584,21 @@ |
|
1635 if (!purity && maxdepth > 0 && *levelp >= maxdepth) { |
|
1636 STRLEN vallen; |
|
1637 const char * const valstr = SvPV(val,vallen); |
|
1638 - sv_catpvn(retval, "'", 1); |
|
1639 + sv_catpvs(retval, "'"); |
|
1640 sv_catpvn(retval, valstr, vallen); |
|
1641 - sv_catpvn(retval, "'", 1); |
|
1642 + sv_catpvs(retval, "'"); |
|
1643 return 1; |
|
1644 } |
|
1645 |
|
1646 + if (maxrecurse > 0 && *levelp >= maxrecurse) { |
|
1647 + croak("Recursion limit of %" IVdf " exceeded", maxrecurse); |
|
1648 + } |
|
1649 + |
|
1650 if (realpack && !no_bless) { /* we have a blessed ref */ |
|
1651 STRLEN blesslen; |
|
1652 const char * const blessstr = SvPV(bless, blesslen); |
|
1653 sv_catpvn(retval, blessstr, blesslen); |
|
1654 - sv_catpvn(retval, "( ", 2); |
|
1655 + sv_catpvs(retval, "( "); |
|
1656 if (indent >= 2) { |
|
1657 blesspad = apad; |
|
1658 apad = newSVsv(apad); |
|
1659 @@ -457,18 +612,58 @@ |
|
1660 if (is_regex) |
|
1661 { |
|
1662 STRLEN rlen; |
|
1663 - const char *rval = SvPV(val, rlen); |
|
1664 - const char *slash = strchr(rval, '/'); |
|
1665 - sv_catpvn(retval, "qr/", 3); |
|
1666 - while (slash) { |
|
1667 + SV *sv_pattern = NULL; |
|
1668 + SV *sv_flags = NULL; |
|
1669 + CV *re_pattern_cv; |
|
1670 + const char *rval; |
|
1671 + const char *rend; |
|
1672 + const char *slash; |
|
1673 + |
|
1674 + if ((re_pattern_cv = get_cv("re::regexp_pattern", 0))) { |
|
1675 + dSP; |
|
1676 + I32 count; |
|
1677 + ENTER; |
|
1678 + SAVETMPS; |
|
1679 + PUSHMARK(SP); |
|
1680 + XPUSHs(val); |
|
1681 + PUTBACK; |
|
1682 + count = call_sv((SV*)re_pattern_cv, G_ARRAY); |
|
1683 + SPAGAIN; |
|
1684 + if (count >= 2) { |
|
1685 + sv_flags = POPs; |
|
1686 + sv_pattern = POPs; |
|
1687 + SvREFCNT_inc(sv_flags); |
|
1688 + SvREFCNT_inc(sv_pattern); |
|
1689 + } |
|
1690 + PUTBACK; |
|
1691 + FREETMPS; |
|
1692 + LEAVE; |
|
1693 + if (sv_pattern) { |
|
1694 + sv_2mortal(sv_pattern); |
|
1695 + sv_2mortal(sv_flags); |
|
1696 + } |
|
1697 + } |
|
1698 + else { |
|
1699 + sv_pattern = val; |
|
1700 + } |
|
1701 + assert(sv_pattern); |
|
1702 + rval = SvPV(sv_pattern, rlen); |
|
1703 + rend = rval+rlen; |
|
1704 + slash = rval; |
|
1705 + sv_catpvs(retval, "qr/"); |
|
1706 + for (;slash < rend; slash++) { |
|
1707 + if (*slash == '\\') { ++slash; continue; } |
|
1708 + if (*slash == '/') { |
|
1709 sv_catpvn(retval, rval, slash-rval); |
|
1710 - sv_catpvn(retval, "\\/", 2); |
|
1711 + sv_catpvs(retval, "\\/"); |
|
1712 rlen -= slash-rval+1; |
|
1713 rval = slash+1; |
|
1714 - slash = strchr(rval, '/'); |
|
1715 + } |
|
1716 } |
|
1717 sv_catpvn(retval, rval, rlen); |
|
1718 - sv_catpvn(retval, "/", 1); |
|
1719 + sv_catpvs(retval, "/"); |
|
1720 + if (sv_flags) |
|
1721 + sv_catsv(retval, sv_flags); |
|
1722 } |
|
1723 else if ( |
|
1724 #if PERL_VERSION < 9 |
|
1725 @@ -477,41 +672,44 @@ |
|
1726 realtype <= SVt_PVMG |
|
1727 #endif |
|
1728 ) { /* scalar ref */ |
|
1729 - SV * const namesv = newSVpvn("${", 2); |
|
1730 + SV * const namesv = newSVpvs("${"); |
|
1731 sv_catpvn(namesv, name, namelen); |
|
1732 - sv_catpvn(namesv, "}", 1); |
|
1733 + sv_catpvs(namesv, "}"); |
|
1734 if (realpack) { /* blessed */ |
|
1735 - sv_catpvn(retval, "do{\\(my $o = ", 13); |
|
1736 + sv_catpvs(retval, "do{\\(my $o = "); |
|
1737 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv, |
|
1738 postav, levelp, indent, pad, xpad, apad, sep, pair, |
|
1739 freezer, toaster, purity, deepcopy, quotekeys, bless, |
|
1740 - maxdepth, sortkeys); |
|
1741 - sv_catpvn(retval, ")}", 2); |
|
1742 + maxdepth, sortkeys, use_sparse_seen_hash, useqq, |
|
1743 + maxrecurse); |
|
1744 + sv_catpvs(retval, ")}"); |
|
1745 } /* plain */ |
|
1746 else { |
|
1747 - sv_catpvn(retval, "\\", 1); |
|
1748 + sv_catpvs(retval, "\\"); |
|
1749 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv, |
|
1750 postav, levelp, indent, pad, xpad, apad, sep, pair, |
|
1751 freezer, toaster, purity, deepcopy, quotekeys, bless, |
|
1752 - maxdepth, sortkeys); |
|
1753 + maxdepth, sortkeys, use_sparse_seen_hash, useqq, |
|
1754 + maxrecurse); |
|
1755 } |
|
1756 SvREFCNT_dec(namesv); |
|
1757 } |
|
1758 else if (realtype == SVt_PVGV) { /* glob ref */ |
|
1759 - SV * const namesv = newSVpvn("*{", 2); |
|
1760 + SV * const namesv = newSVpvs("*{"); |
|
1761 sv_catpvn(namesv, name, namelen); |
|
1762 - sv_catpvn(namesv, "}", 1); |
|
1763 - sv_catpvn(retval, "\\", 1); |
|
1764 + sv_catpvs(namesv, "}"); |
|
1765 + sv_catpvs(retval, "\\"); |
|
1766 DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv, |
|
1767 postav, levelp, indent, pad, xpad, apad, sep, pair, |
|
1768 freezer, toaster, purity, deepcopy, quotekeys, bless, |
|
1769 - maxdepth, sortkeys); |
|
1770 + maxdepth, sortkeys, use_sparse_seen_hash, useqq, |
|
1771 + maxrecurse); |
|
1772 SvREFCNT_dec(namesv); |
|
1773 } |
|
1774 else if (realtype == SVt_PVAV) { |
|
1775 SV *totpad; |
|
1776 - I32 ix = 0; |
|
1777 - const I32 ixmax = av_len((AV *)ival); |
|
1778 + SSize_t ix = 0; |
|
1779 + const SSize_t ixmax = av_len((AV *)ival); |
|
1780 |
|
1781 SV * const ixsv = newSViv(0); |
|
1782 /* allowing for a 24 char wide array index */ |
|
1783 @@ -519,11 +717,11 @@ |
|
1784 (void)strcpy(iname, name); |
|
1785 inamelen = namelen; |
|
1786 if (name[0] == '@') { |
|
1787 - sv_catpvn(retval, "(", 1); |
|
1788 + sv_catpvs(retval, "("); |
|
1789 iname[0] = '$'; |
|
1790 } |
|
1791 else { |
|
1792 - sv_catpvn(retval, "[", 1); |
|
1793 + sv_catpvs(retval, "["); |
|
1794 /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */ |
|
1795 /*if (namelen > 0 |
|
1796 && name[namelen-1] != ']' && name[namelen-1] != '}' |
|
1797 @@ -570,7 +768,7 @@ |
|
1798 if (indent >= 3) { |
|
1799 sv_catsv(retval, totpad); |
|
1800 sv_catsv(retval, ipad); |
|
1801 - sv_catpvn(retval, "#", 1); |
|
1802 + sv_catpvs(retval, "#"); |
|
1803 sv_catsv(retval, ixsv); |
|
1804 } |
|
1805 sv_catsv(retval, totpad); |
|
1806 @@ -578,9 +776,10 @@ |
|
1807 DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav, |
|
1808 levelp, indent, pad, xpad, apad, sep, pair, |
|
1809 freezer, toaster, purity, deepcopy, quotekeys, bless, |
|
1810 - maxdepth, sortkeys); |
|
1811 + maxdepth, sortkeys, use_sparse_seen_hash, |
|
1812 + useqq, maxrecurse); |
|
1813 if (ix < ixmax) |
|
1814 - sv_catpvn(retval, ",", 1); |
|
1815 + sv_catpvs(retval, ","); |
|
1816 } |
|
1817 if (ixmax >= 0) { |
|
1818 SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1); |
|
1819 @@ -589,9 +788,9 @@ |
|
1820 SvREFCNT_dec(opad); |
|
1821 } |
|
1822 if (name[0] == '@') |
|
1823 - sv_catpvn(retval, ")", 1); |
|
1824 + sv_catpvs(retval, ")"); |
|
1825 else |
|
1826 - sv_catpvn(retval, "]", 1); |
|
1827 + sv_catpvs(retval, "]"); |
|
1828 SvREFCNT_dec(ixsv); |
|
1829 SvREFCNT_dec(totpad); |
|
1830 Safefree(iname); |
|
1831 @@ -607,11 +806,11 @@ |
|
1832 |
|
1833 SV * const iname = newSVpvn(name, namelen); |
|
1834 if (name[0] == '%') { |
|
1835 - sv_catpvn(retval, "(", 1); |
|
1836 + sv_catpvs(retval, "("); |
|
1837 (SvPVX(iname))[0] = '$'; |
|
1838 } |
|
1839 else { |
|
1840 - sv_catpvn(retval, "{", 1); |
|
1841 + sv_catpvs(retval, "{"); |
|
1842 /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */ |
|
1843 if ((namelen > 0 |
|
1844 && name[namelen-1] != ']' && name[namelen-1] != '}') |
|
1845 @@ -619,16 +818,16 @@ |
|
1846 && (name[1] == '{' |
|
1847 || (name[0] == '\\' && name[2] == '{')))) |
|
1848 { |
|
1849 - sv_catpvn(iname, "->", 2); |
|
1850 + sv_catpvs(iname, "->"); |
|
1851 } |
|
1852 } |
|
1853 if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 && |
|
1854 (instr(name+namelen-8, "{SCALAR}") || |
|
1855 instr(name+namelen-7, "{ARRAY}") || |
|
1856 instr(name+namelen-6, "{HASH}"))) { |
|
1857 - sv_catpvn(iname, "->", 2); |
|
1858 + sv_catpvs(iname, "->"); |
|
1859 } |
|
1860 - sv_catpvn(iname, "{", 1); |
|
1861 + sv_catpvs(iname, "{"); |
|
1862 totpad = newSVsv(sep); |
|
1863 sv_catsv(totpad, pad); |
|
1864 sv_catsv(totpad, apad); |
|
1865 @@ -637,25 +836,34 @@ |
|
1866 if (sortkeys) { |
|
1867 if (sortkeys == &PL_sv_yes) { |
|
1868 #if PERL_VERSION < 8 |
|
1869 - sortkeys = sv_2mortal(newSVpvn("Data::Dumper::_sortkeys", 23)); |
|
1870 + sortkeys = sv_2mortal(newSVpvs("Data::Dumper::_sortkeys")); |
|
1871 #else |
|
1872 keys = newAV(); |
|
1873 (void)hv_iterinit((HV*)ival); |
|
1874 while ((entry = hv_iternext((HV*)ival))) { |
|
1875 sv = hv_iterkeysv(entry); |
|
1876 - SvREFCNT_inc(sv); |
|
1877 + (void)SvREFCNT_inc(sv); |
|
1878 av_push(keys, sv); |
|
1879 } |
|
1880 -# ifdef USE_LOCALE_NUMERIC |
|
1881 - sortsv(AvARRAY(keys), |
|
1882 - av_len(keys)+1, |
|
1883 - IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp); |
|
1884 -# else |
|
1885 - sortsv(AvARRAY(keys), |
|
1886 - av_len(keys)+1, |
|
1887 - Perl_sv_cmp); |
|
1888 +# ifdef USE_LOCALE_COLLATE |
|
1889 +# ifdef IN_LC /* Use this if available */ |
|
1890 + if (IN_LC(LC_COLLATE)) |
|
1891 +# else |
|
1892 + if (IN_LOCALE) |
|
1893 +# endif |
|
1894 + { |
|
1895 + sortsv(AvARRAY(keys), |
|
1896 + av_len(keys)+1, |
|
1897 + Perl_sv_cmp_locale); |
|
1898 + } |
|
1899 + else |
|
1900 # endif |
|
1901 #endif |
|
1902 + { |
|
1903 + sortsv(AvARRAY(keys), |
|
1904 + av_len(keys)+1, |
|
1905 + Perl_sv_cmp); |
|
1906 + } |
|
1907 } |
|
1908 if (sortkeys != &PL_sv_yes) { |
|
1909 dSP; ENTER; SAVETMPS; PUSHMARK(sp); |
|
1910 @@ -688,22 +896,22 @@ |
|
1911 bool do_utf8 = FALSE; |
|
1912 |
|
1913 if (sortkeys) { |
|
1914 - if (!(keys && (I32)i <= av_len(keys))) break; |
|
1915 + if (!(keys && (SSize_t)i <= av_len(keys))) break; |
|
1916 } else { |
|
1917 if (!(entry = hv_iternext((HV *)ival))) break; |
|
1918 } |
|
1919 |
|
1920 if (i) |
|
1921 - sv_catpvn(retval, ",", 1); |
|
1922 + sv_catpvs(retval, ","); |
|
1923 |
|
1924 if (sortkeys) { |
|
1925 char *key; |
|
1926 svp = av_fetch(keys, i, FALSE); |
|
1927 - keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef); |
|
1928 + keysv = svp ? *svp : sv_newmortal(); |
|
1929 key = SvPV(keysv, keylen); |
|
1930 svp = hv_fetch((HV*)ival, key, |
|
1931 - SvUTF8(keysv) ? -(I32)keylen : keylen, 0); |
|
1932 - hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef); |
|
1933 + SvUTF8(keysv) ? -(I32)keylen : (I32)keylen, 0); |
|
1934 + hval = svp ? *svp : sv_newmortal(); |
|
1935 } |
|
1936 else { |
|
1937 keysv = hv_iterkeysv(entry); |
|
1938 @@ -716,31 +924,27 @@ |
|
1939 |
|
1940 sv_catsv(retval, totpad); |
|
1941 sv_catsv(retval, ipad); |
|
1942 - /* old logic was first to check utf8 flag, and if utf8 always |
|
1943 + /* The (very) |
|
1944 + old logic was first to check utf8 flag, and if utf8 always |
|
1945 call esc_q_utf8. This caused test to break under -Mutf8, |
|
1946 because there even strings like 'c' have utf8 flag on. |
|
1947 Hence with quotekeys == 0 the XS code would still '' quote |
|
1948 them based on flags, whereas the perl code would not, |
|
1949 based on regexps. |
|
1950 - The perl code is correct. |
|
1951 - needs_quote() decides that anything that isn't a valid |
|
1952 - perl identifier needs to be quoted, hence only correctly |
|
1953 - formed strings with no characters outside [A-Za-z0-9_:] |
|
1954 - won't need quoting. None of those characters are used in |
|
1955 - the byte encoding of utf8, so anything with utf8 |
|
1956 - encoded characters in will need quoting. Hence strings |
|
1957 - with utf8 encoded characters in will end up inside do_utf8 |
|
1958 - just like before, but now strings with utf8 flag set but |
|
1959 - only ascii characters will end up in the unquoted section. |
|
1960 - |
|
1961 - There should also be less tests for the (probably currently) |
|
1962 - more common doesn't need quoting case. |
|
1963 - The code is also smaller (22044 vs 22260) because I've been |
|
1964 - able to pull the common logic out to both sides. */ |
|
1965 - if (quotekeys || needs_quote(key)) { |
|
1966 - if (do_utf8) { |
|
1967 + |
|
1968 + The old logic checked that the string was a valid |
|
1969 + perl glob name (foo::bar), which isn't safe under |
|
1970 + strict, and differs from the perl code which only |
|
1971 + accepts simple identifiers. |
|
1972 + |
|
1973 + With the fix for [perl #120384] I chose to make |
|
1974 + their handling of key quoting compatible between XS |
|
1975 + and perl. |
|
1976 + */ |
|
1977 + if (quotekeys || key_needs_quote(key,keylen)) { |
|
1978 + if (do_utf8 || useqq) { |
|
1979 STRLEN ocur = SvCUR(retval); |
|
1980 - nlen = esc_q_utf8(aTHX_ retval, key, klen); |
|
1981 + nlen = esc_q_utf8(aTHX_ retval, key, klen, do_utf8, useqq); |
|
1982 nkey = SvPVX(retval) + ocur; |
|
1983 } |
|
1984 else { |
|
1985 @@ -765,7 +969,7 @@ |
|
1986 } |
|
1987 sname = newSVsv(iname); |
|
1988 sv_catpvn(sname, nkey, nlen); |
|
1989 - sv_catpvn(sname, "}", 1); |
|
1990 + sv_catpvs(sname, "}"); |
|
1991 |
|
1992 sv_catsv(retval, pair); |
|
1993 if (indent >= 2) { |
|
1994 @@ -785,7 +989,8 @@ |
|
1995 DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv, |
|
1996 postav, levelp, indent, pad, xpad, newapad, sep, pair, |
|
1997 freezer, toaster, purity, deepcopy, quotekeys, bless, |
|
1998 - maxdepth, sortkeys); |
|
1999 + maxdepth, sortkeys, use_sparse_seen_hash, useqq, |
|
2000 + maxrecurse); |
|
2001 SvREFCNT_dec(sname); |
|
2002 Safefree(nkey_buffer); |
|
2003 if (indent >= 2) |
|
2004 @@ -798,19 +1003,19 @@ |
|
2005 SvREFCNT_dec(opad); |
|
2006 } |
|
2007 if (name[0] == '%') |
|
2008 - sv_catpvn(retval, ")", 1); |
|
2009 + sv_catpvs(retval, ")"); |
|
2010 else |
|
2011 - sv_catpvn(retval, "}", 1); |
|
2012 + sv_catpvs(retval, "}"); |
|
2013 SvREFCNT_dec(iname); |
|
2014 SvREFCNT_dec(totpad); |
|
2015 } |
|
2016 else if (realtype == SVt_PVCV) { |
|
2017 - sv_catpvn(retval, "sub { \"DUMMY\" }", 15); |
|
2018 + sv_catpvs(retval, "sub { \"DUMMY\" }"); |
|
2019 if (purity) |
|
2020 warn("Encountered CODE ref, using dummy placeholder"); |
|
2021 } |
|
2022 else { |
|
2023 - warn("cannot handle ref type %ld", realtype); |
|
2024 + warn("cannot handle ref type %d", (int)realtype); |
|
2025 } |
|
2026 |
|
2027 if (realpack && !no_bless) { /* free blessed allocs */ |
|
2028 @@ -821,7 +1026,7 @@ |
|
2029 SvREFCNT_dec(apad); |
|
2030 apad = blesspad; |
|
2031 } |
|
2032 - sv_catpvn(retval, ", '", 3); |
|
2033 + sv_catpvs(retval, ", '"); |
|
2034 |
|
2035 plen = strlen(realpack); |
|
2036 pticks = num_q(realpack, plen); |
|
2037 @@ -840,11 +1045,11 @@ |
|
2038 else { |
|
2039 sv_catpvn(retval, realpack, strlen(realpack)); |
|
2040 } |
|
2041 - sv_catpvn(retval, "' )", 3); |
|
2042 + sv_catpvs(retval, "' )"); |
|
2043 if (toaster && SvPOK(toaster) && SvCUR(toaster)) { |
|
2044 - sv_catpvn(retval, "->", 2); |
|
2045 + sv_catpvs(retval, "->"); |
|
2046 sv_catsv(retval, toaster); |
|
2047 - sv_catpvn(retval, "()", 2); |
|
2048 + sv_catpvs(retval, "()"); |
|
2049 } |
|
2050 } |
|
2051 SvREFCNT_dec(ipad); |
|
2052 @@ -852,6 +1057,7 @@ |
|
2053 } |
|
2054 else { |
|
2055 STRLEN i; |
|
2056 + const MAGIC *mg; |
|
2057 |
|
2058 if (namelen) { |
|
2059 #ifdef DD_USE_OLD_ID_FORMAT |
|
2060 @@ -868,14 +1074,21 @@ |
|
2061 if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp) |
|
2062 && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0) |
|
2063 { |
|
2064 - sv_catpvn(retval, "${", 2); |
|
2065 + sv_catpvs(retval, "${"); |
|
2066 sv_catsv(retval, othername); |
|
2067 - sv_catpvn(retval, "}", 1); |
|
2068 + sv_catpvs(retval, "}"); |
|
2069 return 1; |
|
2070 } |
|
2071 } |
|
2072 - else if (val != &PL_sv_undef) { |
|
2073 - SV * const namesv = newSVpvn("\\", 1); |
|
2074 + /* If we're allowed to keep only a sparse "seen" hash |
|
2075 + * (IOW, the user does not expect it to contain everything |
|
2076 + * after the dump, then only store in seen hash if the SV |
|
2077 + * ref count is larger than 1. If it's 1, then we know that |
|
2078 + * there is no other reference, duh. This is an optimization. |
|
2079 + * Note that we'd have to check for weak-refs, too, but this is |
|
2080 + * already the branch for non-refs only. */ |
|
2081 + else if (val != &PL_sv_undef && (!use_sparse_seen_hash || SvREFCNT(val) > 1)) { |
|
2082 + SV * const namesv = newSVpvs("\\"); |
|
2083 sv_catpvn(namesv, name, namelen); |
|
2084 seenentry = newAV(); |
|
2085 av_push(seenentry, namesv); |
|
2086 @@ -909,12 +1122,32 @@ |
|
2087 } |
|
2088 else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */ |
|
2089 c = SvPV(val, i); |
|
2090 - ++c; --i; /* just get the name */ |
|
2091 + if(i) ++c, --i; /* just get the name */ |
|
2092 if (i >= 6 && strncmp(c, "main::", 6) == 0) { |
|
2093 c += 4; |
|
2094 - i -= 4; |
|
2095 +#if PERL_VERSION < 7 |
|
2096 + if (i == 6 || (i == 7 && c[6] == '\0')) |
|
2097 +#else |
|
2098 + if (i == 6) |
|
2099 +#endif |
|
2100 + i = 0; else i -= 4; |
|
2101 } |
|
2102 - if (needs_quote(c)) { |
|
2103 + if (globname_needs_quote(c,i)) { |
|
2104 +#ifdef GvNAMEUTF8 |
|
2105 + if (GvNAMEUTF8(val)) { |
|
2106 + sv_grow(retval, SvCUR(retval)+2); |
|
2107 + r = SvPVX(retval)+SvCUR(retval); |
|
2108 + r[0] = '*'; r[1] = '{'; |
|
2109 + SvCUR_set(retval, SvCUR(retval)+2); |
|
2110 + esc_q_utf8(aTHX_ retval, c, i, 1, useqq); |
|
2111 + sv_grow(retval, SvCUR(retval)+2); |
|
2112 + r = SvPVX(retval)+SvCUR(retval); |
|
2113 + r[0] = '}'; r[1] = '\0'; |
|
2114 + i = 1; |
|
2115 + } |
|
2116 + else |
|
2117 +#endif |
|
2118 + { |
|
2119 sv_grow(retval, SvCUR(retval)+6+2*i); |
|
2120 r = SvPVX(retval)+SvCUR(retval); |
|
2121 r[0] = '*'; r[1] = '{'; r[2] = '\''; |
|
2122 @@ -922,6 +1155,7 @@ |
|
2123 i += 3; |
|
2124 r[i++] = '\''; r[i++] = '}'; |
|
2125 r[i] = '\0'; |
|
2126 + } |
|
2127 } |
|
2128 else { |
|
2129 sv_grow(retval, SvCUR(retval)+i+2); |
|
2130 @@ -935,8 +1169,8 @@ |
|
2131 static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" }; |
|
2132 static const STRLEN sizes[] = { 8, 7, 6 }; |
|
2133 SV *e; |
|
2134 - SV * const nname = newSVpvn("", 0); |
|
2135 - SV * const newapad = newSVpvn("", 0); |
|
2136 + SV * const nname = newSVpvs(""); |
|
2137 + SV * const newapad = newSVpvs(""); |
|
2138 GV * const gv = (GV*)val; |
|
2139 I32 j; |
|
2140 |
|
2141 @@ -953,7 +1187,7 @@ |
|
2142 |
|
2143 sv_setsv(nname, postentry); |
|
2144 sv_catpvn(nname, entries[j], sizes[j]); |
|
2145 - sv_catpvn(postentry, " = ", 3); |
|
2146 + sv_catpvs(postentry, " = "); |
|
2147 av_push(postav, postentry); |
|
2148 e = newRV_inc(e); |
|
2149 |
|
2150 @@ -965,7 +1199,8 @@ |
|
2151 seenhv, postav, &nlevel, indent, pad, xpad, |
|
2152 newapad, sep, pair, freezer, toaster, purity, |
|
2153 deepcopy, quotekeys, bless, maxdepth, |
|
2154 - sortkeys); |
|
2155 + sortkeys, use_sparse_seen_hash, useqq, |
|
2156 + maxrecurse); |
|
2157 SvREFCNT_dec(e); |
|
2158 } |
|
2159 } |
|
2160 @@ -975,13 +1210,36 @@ |
|
2161 } |
|
2162 } |
|
2163 else if (val == &PL_sv_undef || !SvOK(val)) { |
|
2164 - sv_catpvn(retval, "undef", 5); |
|
2165 + sv_catpvs(retval, "undef"); |
|
2166 } |
|
2167 +#ifdef SvVOK |
|
2168 + else if (SvMAGICAL(val) && (mg = mg_find(val, 'V'))) { |
|
2169 +# if !defined(PL_vtbl_vstring) && PERL_VERSION < 17 |
|
2170 + SV * const vecsv = sv_newmortal(); |
|
2171 +# if PERL_VERSION < 10 |
|
2172 + scan_vstring(mg->mg_ptr, vecsv); |
|
2173 +# else |
|
2174 + scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv); |
|
2175 +# endif |
|
2176 + if (!sv_eq(vecsv, val)) goto integer_came_from_string; |
|
2177 +# endif |
|
2178 + sv_catpvn(retval, (const char *)mg->mg_ptr, mg->mg_len); |
|
2179 + } |
|
2180 +#endif |
|
2181 + |
|
2182 else { |
|
2183 integer_came_from_string: |
|
2184 - c = SvPV(val, i); |
|
2185 - if (DO_UTF8(val)) |
|
2186 - i += esc_q_utf8(aTHX_ retval, c, i); |
|
2187 + c = SvPV(val, i); |
|
2188 + /* the pure perl and XS non-qq outputs have historically been |
|
2189 + * different in this case, but for useqq, let's try to match |
|
2190 + * the pure perl code. |
|
2191 + * see [perl #74798] |
|
2192 + */ |
|
2193 + if (useqq && safe_decimal_number(c, i)) { |
|
2194 + sv_catsv(retval, val); |
|
2195 + } |
|
2196 + else if (DO_UTF8(val) || useqq) |
|
2197 + i += esc_q_utf8(aTHX_ retval, c, i, DO_UTF8(val), useqq); |
|
2198 else { |
|
2199 sv_grow(retval, SvCUR(retval)+3+2*i); /* 3: ""\0 */ |
|
2200 r = SvPVX(retval) + SvCUR(retval); |
|
2201 @@ -1012,7 +1270,7 @@ |
|
2202 # |
|
2203 # This is the exact equivalent of Dump. Well, almost. The things that are |
|
2204 # different as of now (due to Laziness): |
|
2205 -# * doesnt do double-quotes yet. |
|
2206 +# * doesn't deparse yet.' |
|
2207 # |
|
2208 |
|
2209 void |
|
2210 @@ -1026,13 +1284,16 @@ |
|
2211 HV *seenhv = NULL; |
|
2212 AV *postav, *todumpav, *namesav; |
|
2213 I32 level = 0; |
|
2214 - I32 indent, terse, i, imax, postlen; |
|
2215 + I32 indent, terse, useqq; |
|
2216 + SSize_t i, imax, postlen; |
|
2217 SV **svp; |
|
2218 SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname; |
|
2219 SV *freezer, *toaster, *bless, *sortkeys; |
|
2220 I32 purity, deepcopy, quotekeys, maxdepth = 0; |
|
2221 + IV maxrecurse = 1000; |
|
2222 char tmpbuf[1024]; |
|
2223 I32 gimme = GIMME; |
|
2224 + int use_sparse_seen_hash = 0; |
|
2225 |
|
2226 if (!SvROK(href)) { /* call new to get an object first */ |
|
2227 if (items < 2) |
|
2228 @@ -1042,10 +1303,11 @@ |
|
2229 SAVETMPS; |
|
2230 |
|
2231 PUSHMARK(sp); |
|
2232 - XPUSHs(href); |
|
2233 - XPUSHs(sv_2mortal(newSVsv(ST(1)))); |
|
2234 + EXTEND(SP, 3); /* 3 == max of all branches below */ |
|
2235 + PUSHs(href); |
|
2236 + PUSHs(sv_2mortal(newSVsv(ST(1)))); |
|
2237 if (items >= 3) |
|
2238 - XPUSHs(sv_2mortal(newSVsv(ST(2)))); |
|
2239 + PUSHs(sv_2mortal(newSVsv(ST(2)))); |
|
2240 PUTBACK; |
|
2241 i = perl_call_method("new", G_SCALAR); |
|
2242 SPAGAIN; |
|
2243 @@ -1065,16 +1327,20 @@ |
|
2244 = freezer = toaster = bless = sortkeys = &PL_sv_undef; |
|
2245 name = sv_newmortal(); |
|
2246 indent = 2; |
|
2247 - terse = purity = deepcopy = 0; |
|
2248 + terse = purity = deepcopy = useqq = 0; |
|
2249 quotekeys = 1; |
|
2250 |
|
2251 - retval = newSVpvn("", 0); |
|
2252 + retval = newSVpvs(""); |
|
2253 if (SvROK(href) |
|
2254 && (hv = (HV*)SvRV((SV*)href)) |
|
2255 && SvTYPE(hv) == SVt_PVHV) { |
|
2256 |
|
2257 if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp)) |
|
2258 seenhv = (HV*)SvRV(*svp); |
|
2259 + else |
|
2260 + use_sparse_seen_hash = 1; |
|
2261 + if ((svp = hv_fetch(hv, "noseen", 6, FALSE))) |
|
2262 + use_sparse_seen_hash = (SvOK(*svp) && SvIV(*svp) != 0); |
|
2263 if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp)) |
|
2264 todumpav = (AV*)SvRV(*svp); |
|
2265 if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp)) |
|
2266 @@ -1085,10 +1351,8 @@ |
|
2267 purity = SvIV(*svp); |
|
2268 if ((svp = hv_fetch(hv, "terse", 5, FALSE))) |
|
2269 terse = SvTRUE(*svp); |
|
2270 -#if 0 /* useqq currently unused */ |
|
2271 if ((svp = hv_fetch(hv, "useqq", 5, FALSE))) |
|
2272 useqq = SvTRUE(*svp); |
|
2273 -#endif |
|
2274 if ((svp = hv_fetch(hv, "pad", 3, FALSE))) |
|
2275 pad = *svp; |
|
2276 if ((svp = hv_fetch(hv, "xpad", 4, FALSE))) |
|
2277 @@ -1113,6 +1377,8 @@ |
|
2278 bless = *svp; |
|
2279 if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE))) |
|
2280 maxdepth = SvIV(*svp); |
|
2281 + if ((svp = hv_fetch(hv, "maxrecurse", 10, FALSE))) |
|
2282 + maxrecurse = SvIV(*svp); |
|
2283 if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) { |
|
2284 sortkeys = *svp; |
|
2285 if (! SvTRUE(sortkeys)) |
|
2286 @@ -1130,7 +1396,7 @@ |
|
2287 imax = av_len(todumpav); |
|
2288 else |
|
2289 imax = -1; |
|
2290 - valstr = newSVpvn("",0); |
|
2291 + valstr = newSVpvs(""); |
|
2292 for (i = 0; i <= imax; ++i) { |
|
2293 SV *newapad; |
|
2294 |
|
2295 @@ -1179,7 +1445,7 @@ |
|
2296 sv_catpvn(name, tmpbuf, nchars); |
|
2297 } |
|
2298 |
|
2299 - if (indent >= 2) { |
|
2300 + if (indent >= 2 && !terse) { |
|
2301 SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3); |
|
2302 newapad = newSVsv(apad); |
|
2303 sv_catsv(newapad, tmpsv); |
|
2304 @@ -1188,25 +1454,28 @@ |
|
2305 else |
|
2306 newapad = apad; |
|
2307 |
|
2308 + PUTBACK; |
|
2309 DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv, |
|
2310 postav, &level, indent, pad, xpad, newapad, sep, pair, |
|
2311 freezer, toaster, purity, deepcopy, quotekeys, |
|
2312 - bless, maxdepth, sortkeys); |
|
2313 + bless, maxdepth, sortkeys, use_sparse_seen_hash, |
|
2314 + useqq, maxrecurse); |
|
2315 + SPAGAIN; |
|
2316 |
|
2317 - if (indent >= 2) |
|
2318 + if (indent >= 2 && !terse) |
|
2319 SvREFCNT_dec(newapad); |
|
2320 |
|
2321 postlen = av_len(postav); |
|
2322 if (postlen >= 0 || !terse) { |
|
2323 sv_insert(valstr, 0, 0, " = ", 3); |
|
2324 sv_insert(valstr, 0, 0, SvPVX_const(name), SvCUR(name)); |
|
2325 - sv_catpvn(valstr, ";", 1); |
|
2326 + sv_catpvs(valstr, ";"); |
|
2327 } |
|
2328 sv_catsv(retval, pad); |
|
2329 sv_catsv(retval, valstr); |
|
2330 sv_catsv(retval, sep); |
|
2331 if (postlen >= 0) { |
|
2332 - I32 i; |
|
2333 + SSize_t i; |
|
2334 sv_catsv(retval, pad); |
|
2335 for (i = 0; i <= postlen; ++i) { |
|
2336 SV *elem; |
|
2337 @@ -1214,20 +1483,20 @@ |
|
2338 if (svp && (elem = *svp)) { |
|
2339 sv_catsv(retval, elem); |
|
2340 if (i < postlen) { |
|
2341 - sv_catpvn(retval, ";", 1); |
|
2342 + sv_catpvs(retval, ";"); |
|
2343 sv_catsv(retval, sep); |
|
2344 sv_catsv(retval, pad); |
|
2345 } |
|
2346 } |
|
2347 } |
|
2348 - sv_catpvn(retval, ";", 1); |
|
2349 + sv_catpvs(retval, ";"); |
|
2350 sv_catsv(retval, sep); |
|
2351 } |
|
2352 sv_setpvn(valstr, "", 0); |
|
2353 if (gimme == G_ARRAY) { |
|
2354 XPUSHs(sv_2mortal(retval)); |
|
2355 if (i < imax) /* not the last time thro ? */ |
|
2356 - retval = newSVpvn("",0); |
|
2357 + retval = newSVpvs(""); |
|
2358 } |
|
2359 } |
|
2360 SvREFCNT_dec(postav); |
|
2361 @@ -1238,3 +1507,21 @@ |
|
2362 if (gimme == G_SCALAR) |
|
2363 XPUSHs(sv_2mortal(retval)); |
|
2364 } |
|
2365 + |
|
2366 +SV * |
|
2367 +Data_Dumper__vstring(sv) |
|
2368 + SV *sv; |
|
2369 + PROTOTYPE: $ |
|
2370 + CODE: |
|
2371 + { |
|
2372 +#ifdef SvVOK |
|
2373 + const MAGIC *mg; |
|
2374 + RETVAL = |
|
2375 + SvMAGICAL(sv) && (mg = mg_find(sv, 'V')) |
|
2376 + ? newSVpvn((const char *)mg->mg_ptr, mg->mg_len) |
|
2377 + : &PL_sv_undef; |
|
2378 +#else |
|
2379 + RETVAL = &PL_sv_undef; |
|
2380 +#endif |
|
2381 + } |
|
2382 + OUTPUT: RETVAL |
|
2383 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/Makefile.PL perl-5.12.5_dumper/dist/Data-Dumper/Makefile.PL |
|
2384 --- perl-5.12.5/dist/Data-Dumper/Makefile.PL 1969-12-31 19:00:00.000000000 -0500 |
|
2385 +++ perl-5.12.5_dumper/dist/Data-Dumper/Makefile.PL 2014-10-09 15:06:36.168520426 -0400 |
|
2386 @@ -0,0 +1,25 @@ |
|
2387 +use 5.006001; |
|
2388 +use ExtUtils::MakeMaker; |
|
2389 +WriteMakefile( |
|
2390 + NAME => "Data::Dumper", |
|
2391 + VERSION_FROM => 'Dumper.pm', |
|
2392 + 'dist' => { |
|
2393 + COMPRESS => 'gzip -9f', |
|
2394 + SUFFIX => 'gz', |
|
2395 + DIST_DEFAULT => 'all tardist', |
|
2396 + }, |
|
2397 + MAN3PODS => {}, |
|
2398 + DEFINE => '-DUSE_PPPORT_H', |
|
2399 + INSTALLDIRS => 'perl', |
|
2400 + BUILD_REQUIRES => { |
|
2401 + Test::More => '0.98', |
|
2402 + }, |
|
2403 + META_MERGE => { |
|
2404 + dynamic_config => 0, |
|
2405 + resources => { |
|
2406 + repository => 'git://perl5.git.perl.org/perl.git perl-git', |
|
2407 + bugtracker => 'http://rt.perl.org/perlbug/', |
|
2408 + MailingList => 'http://lists.cpan.org/showlist.cgi?name=perl5-porters' |
|
2409 + }, |
|
2410 + } |
|
2411 +); |
|
2412 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/MANIFEST perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST |
|
2413 --- perl-5.12.5/dist/Data-Dumper/MANIFEST 1969-12-31 19:00:00.000000000 -0500 |
|
2414 +++ perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST 2014-10-09 15:06:36.168906933 -0400 |
|
2415 @@ -0,0 +1,34 @@ |
|
2416 +Changes |
|
2417 +Dumper.pm |
|
2418 +Dumper.xs |
|
2419 +Makefile.PL |
|
2420 +MANIFEST This list of files |
|
2421 +MANIFEST.SKIP |
|
2422 +ppport.h |
|
2423 +t/bless.t |
|
2424 +t/bless_var_method.t |
|
2425 +t/bugs.t |
|
2426 +t/deparse.t |
|
2427 +t/dumper.t |
|
2428 +t/dumpperl.t |
|
2429 +t/freezer.t |
|
2430 +t/freezer_useperl.t |
|
2431 +t/indent.t |
|
2432 +t/lib/Testing.pm |
|
2433 +t/misc.t |
|
2434 +t/names.t |
|
2435 +t/overload.t |
|
2436 +t/pair.t |
|
2437 +t/perl-74170.t |
|
2438 +t/purity_deepcopy_maxdepth.t |
|
2439 +t/qr.t |
|
2440 +t/quotekeys.t |
|
2441 +t/recurse.t |
|
2442 +t/seen.t |
|
2443 +t/sortkeys.t |
|
2444 +t/sparseseen.t |
|
2445 +t/terse.t |
|
2446 +t/toaster.t |
|
2447 +t/values.t |
|
2448 +Todo |
|
2449 +META.yml Module meta-data (added by MakeMaker) |
|
2450 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/MANIFEST.SKIP perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST.SKIP |
|
2451 --- perl-5.12.5/dist/Data-Dumper/MANIFEST.SKIP 1969-12-31 19:00:00.000000000 -0500 |
|
2452 +++ perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST.SKIP 2014-10-09 15:06:36.169255091 -0400 |
|
2453 @@ -0,0 +1,33 @@ |
|
2454 +Dumper\.bs$ |
|
2455 +Dumper\.c$ |
|
2456 +\.o$ |
|
2457 +\.git/ |
|
2458 +\.gitignore$ |
|
2459 +\b(?:MY)?META\.(?:json|yml)$ |
|
2460 + |
|
2461 +# Default section: |
|
2462 +# Avoid version control files. |
|
2463 +\bRCS\b |
|
2464 +\bCVS\b |
|
2465 +,v$ |
|
2466 +\B\.svn\b |
|
2467 + |
|
2468 +# Avoid Makemaker generated and utility files. |
|
2469 +\bMakefile$ |
|
2470 +\bblib |
|
2471 +\bMakeMaker-\d |
|
2472 +\bpm_to_blib$ |
|
2473 +\bblibdirs$ |
|
2474 + |
|
2475 +# Avoid Module::Build generated and utility files. |
|
2476 +\bBuild$ |
|
2477 +\b_build |
|
2478 + |
|
2479 +# Avoid temp and backup files. |
|
2480 +~$ |
|
2481 +\.tmp$ |
|
2482 +\.old$ |
|
2483 +\.bak$ |
|
2484 +\#$ |
|
2485 +\b\.# |
|
2486 +\b\..*\.sw[op]$ |
|
2487 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/META.yml perl-5.12.5_dumper/dist/Data-Dumper/META.yml |
|
2488 --- perl-5.12.5/dist/Data-Dumper/META.yml 1969-12-31 19:00:00.000000000 -0500 |
|
2489 +++ perl-5.12.5_dumper/dist/Data-Dumper/META.yml 2014-10-09 15:06:36.169646557 -0400 |
|
2490 @@ -0,0 +1,25 @@ |
|
2491 +--- #YAML:1.0 |
|
2492 +name: Data-Dumper |
|
2493 +version: 2.154 |
|
2494 +abstract: ~ |
|
2495 +author: [] |
|
2496 +license: unknown |
|
2497 +distribution_type: module |
|
2498 +configure_requires: |
|
2499 + ExtUtils::MakeMaker: 0 |
|
2500 +build_requires: |
|
2501 + Test::More: 0.98 |
|
2502 +requires: {} |
|
2503 +resources: |
|
2504 + bugtracker: http://rt.perl.org/perlbug/ |
|
2505 + MailingList: http://lists.cpan.org/showlist.cgi?name=perl5-porters |
|
2506 + repository: git://perl5.git.perl.org/perl.git perl-git |
|
2507 +no_index: |
|
2508 + directory: |
|
2509 + - t |
|
2510 + - inc |
|
2511 +generated_by: ExtUtils::MakeMaker version 6.57_05 |
|
2512 +meta-spec: |
|
2513 + url: http://module-build.sourceforge.net/META-spec-v1.4.html |
|
2514 + version: 1.4 |
|
2515 +dynamic_config: 0 |
|
2516 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/ppport.h perl-5.12.5_dumper/dist/Data-Dumper/ppport.h |
|
2517 --- perl-5.12.5/dist/Data-Dumper/ppport.h 1969-12-31 19:00:00.000000000 -0500 |
|
2518 +++ perl-5.12.5_dumper/dist/Data-Dumper/ppport.h 2014-10-09 15:06:36.171549607 -0400 |
|
2519 @@ -0,0 +1,7452 @@ |
|
2520 +#if 0 |
|
2521 +<<'SKIP'; |
|
2522 +#endif |
|
2523 +/* |
|
2524 +---------------------------------------------------------------------- |
|
2525 + |
|
2526 + ppport.h -- Perl/Pollution/Portability Version 3.21 |
|
2527 + |
|
2528 + Automatically created by Devel::PPPort running under perl 5.014002. |
|
2529 + |
|
2530 + Do NOT edit this file directly! -- Edit PPPort_pm.PL and the |
|
2531 + includes in parts/inc/ instead. |
|
2532 + |
|
2533 + Use 'perldoc ppport.h' to view the documentation below. |
|
2534 + |
|
2535 +---------------------------------------------------------------------- |
|
2536 + |
|
2537 +SKIP |
|
2538 + |
|
2539 +=pod |
|
2540 + |
|
2541 +=head1 NAME |
|
2542 + |
|
2543 +ppport.h - Perl/Pollution/Portability version 3.21 |
|
2544 + |
|
2545 +=head1 SYNOPSIS |
|
2546 + |
|
2547 + perl ppport.h [options] [source files] |
|
2548 + |
|
2549 + Searches current directory for files if no [source files] are given |
|
2550 + |
|
2551 + --help show short help |
|
2552 + |
|
2553 + --version show version |
|
2554 + |
|
2555 + --patch=file write one patch file with changes |
|
2556 + --copy=suffix write changed copies with suffix |
|
2557 + --diff=program use diff program and options |
|
2558 + |
|
2559 + --compat-version=version provide compatibility with Perl version |
|
2560 + --cplusplus accept C++ comments |
|
2561 + |
|
2562 + --quiet don't output anything except fatal errors |
|
2563 + --nodiag don't show diagnostics |
|
2564 + --nohints don't show hints |
|
2565 + --nochanges don't suggest changes |
|
2566 + --nofilter don't filter input files |
|
2567 + |
|
2568 + --strip strip all script and doc functionality from |
|
2569 + ppport.h |
|
2570 + |
|
2571 + --list-provided list provided API |
|
2572 + --list-unsupported list unsupported API |
|
2573 + --api-info=name show Perl API portability information |
|
2574 + |
|
2575 +=head1 COMPATIBILITY |
|
2576 + |
|
2577 +This version of F<ppport.h> is designed to support operation with Perl |
|
2578 +installations back to 5.003, and has been tested up to 5.11.5. |
|
2579 + |
|
2580 +=head1 OPTIONS |
|
2581 + |
|
2582 +=head2 --help |
|
2583 + |
|
2584 +Display a brief usage summary. |
|
2585 + |
|
2586 +=head2 --version |
|
2587 + |
|
2588 +Display the version of F<ppport.h>. |
|
2589 + |
|
2590 +=head2 --patch=I<file> |
|
2591 + |
|
2592 +If this option is given, a single patch file will be created if |
|
2593 +any changes are suggested. This requires a working diff program |
|
2594 +to be installed on your system. |
|
2595 + |
|
2596 +=head2 --copy=I<suffix> |
|
2597 + |
|
2598 +If this option is given, a copy of each file will be saved with |
|
2599 +the given suffix that contains the suggested changes. This does |
|
2600 +not require any external programs. Note that this does not |
|
2601 +automagially add a dot between the original filename and the |
|
2602 +suffix. If you want the dot, you have to include it in the option |
|
2603 +argument. |
|
2604 + |
|
2605 +If neither C<--patch> or C<--copy> are given, the default is to |
|
2606 +simply print the diffs for each file. This requires either |
|
2607 +C<Text::Diff> or a C<diff> program to be installed. |
|
2608 + |
|
2609 +=head2 --diff=I<program> |
|
2610 + |
|
2611 +Manually set the diff program and options to use. The default |
|
2612 +is to use C<Text::Diff>, when installed, and output unified |
|
2613 +context diffs. |
|
2614 + |
|
2615 +=head2 --compat-version=I<version> |
|
2616 + |
|
2617 +Tell F<ppport.h> to check for compatibility with the given |
|
2618 +Perl version. The default is to check for compatibility with Perl |
|
2619 +version 5.003. You can use this option to reduce the output |
|
2620 +of F<ppport.h> if you intend to be backward compatible only |
|
2621 +down to a certain Perl version. |
|
2622 + |
|
2623 +=head2 --cplusplus |
|
2624 + |
|
2625 +Usually, F<ppport.h> will detect C++ style comments and |
|
2626 +replace them with C style comments for portability reasons. |
|
2627 +Using this option instructs F<ppport.h> to leave C++ |
|
2628 +comments untouched. |
|
2629 + |
|
2630 +=head2 --quiet |
|
2631 + |
|
2632 +Be quiet. Don't print anything except fatal errors. |
|
2633 + |
|
2634 +=head2 --nodiag |
|
2635 + |
|
2636 +Don't output any diagnostic messages. Only portability |
|
2637 +alerts will be printed. |
|
2638 + |
|
2639 +=head2 --nohints |
|
2640 + |
|
2641 +Don't output any hints. Hints often contain useful portability |
|
2642 +notes. Warnings will still be displayed. |
|
2643 + |
|
2644 +=head2 --nochanges |
|
2645 + |
|
2646 +Don't suggest any changes. Only give diagnostic output and hints |
|
2647 +unless these are also deactivated. |
|
2648 + |
|
2649 +=head2 --nofilter |
|
2650 + |
|
2651 +Don't filter the list of input files. By default, files not looking |
|
2652 +like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. |
|
2653 + |
|
2654 +=head2 --strip |
|
2655 + |
|
2656 +Strip all script and documentation functionality from F<ppport.h>. |
|
2657 +This reduces the size of F<ppport.h> dramatically and may be useful |
|
2658 +if you want to include F<ppport.h> in smaller modules without |
|
2659 +increasing their distribution size too much. |
|
2660 + |
|
2661 +The stripped F<ppport.h> will have a C<--unstrip> option that allows |
|
2662 +you to undo the stripping, but only if an appropriate C<Devel::PPPort> |
|
2663 +module is installed. |
|
2664 + |
|
2665 +=head2 --list-provided |
|
2666 + |
|
2667 +Lists the API elements for which compatibility is provided by |
|
2668 +F<ppport.h>. Also lists if it must be explicitly requested, |
|
2669 +if it has dependencies, and if there are hints or warnings for it. |
|
2670 + |
|
2671 +=head2 --list-unsupported |
|
2672 + |
|
2673 +Lists the API elements that are known not to be supported by |
|
2674 +F<ppport.h> and below which version of Perl they probably |
|
2675 +won't be available or work. |
|
2676 + |
|
2677 +=head2 --api-info=I<name> |
|
2678 + |
|
2679 +Show portability information for API elements matching I<name>. |
|
2680 +If I<name> is surrounded by slashes, it is interpreted as a regular |
|
2681 +expression. |
|
2682 + |
|
2683 +=head1 DESCRIPTION |
|
2684 + |
|
2685 +In order for a Perl extension (XS) module to be as portable as possible |
|
2686 +across differing versions of Perl itself, certain steps need to be taken. |
|
2687 + |
|
2688 +=over 4 |
|
2689 + |
|
2690 +=item * |
|
2691 + |
|
2692 +Including this header is the first major one. This alone will give you |
|
2693 +access to a large part of the Perl API that hasn't been available in |
|
2694 +earlier Perl releases. Use |
|
2695 + |
|
2696 + perl ppport.h --list-provided |
|
2697 + |
|
2698 +to see which API elements are provided by ppport.h. |
|
2699 + |
|
2700 +=item * |
|
2701 + |
|
2702 +You should avoid using deprecated parts of the API. For example, using |
|
2703 +global Perl variables without the C<PL_> prefix is deprecated. Also, |
|
2704 +some API functions used to have a C<perl_> prefix. Using this form is |
|
2705 +also deprecated. You can safely use the supported API, as F<ppport.h> |
|
2706 +will provide wrappers for older Perl versions. |
|
2707 + |
|
2708 +=item * |
|
2709 + |
|
2710 +If you use one of a few functions or variables that were not present in |
|
2711 +earlier versions of Perl, and that can't be provided using a macro, you |
|
2712 +have to explicitly request support for these functions by adding one or |
|
2713 +more C<#define>s in your source code before the inclusion of F<ppport.h>. |
|
2714 + |
|
2715 +These functions or variables will be marked C<explicit> in the list shown |
|
2716 +by C<--list-provided>. |
|
2717 + |
|
2718 +Depending on whether you module has a single or multiple files that |
|
2719 +use such functions or variables, you want either C<static> or global |
|
2720 +variants. |
|
2721 + |
|
2722 +For a C<static> function or variable (used only in a single source |
|
2723 +file), use: |
|
2724 + |
|
2725 + #define NEED_function |
|
2726 + #define NEED_variable |
|
2727 + |
|
2728 +For a global function or variable (used in multiple source files), |
|
2729 +use: |
|
2730 + |
|
2731 + #define NEED_function_GLOBAL |
|
2732 + #define NEED_variable_GLOBAL |
|
2733 + |
|
2734 +Note that you mustn't have more than one global request for the |
|
2735 +same function or variable in your project. |
|
2736 + |
|
2737 + Function / Variable Static Request Global Request |
|
2738 + ----------------------------------------------------------------------------------------- |
|
2739 + PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL |
|
2740 + PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL |
|
2741 + eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL |
|
2742 + grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL |
|
2743 + grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL |
|
2744 + grok_number() NEED_grok_number NEED_grok_number_GLOBAL |
|
2745 + grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL |
|
2746 + grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL |
|
2747 + load_module() NEED_load_module NEED_load_module_GLOBAL |
|
2748 + my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL |
|
2749 + my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL |
|
2750 + my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL |
|
2751 + my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL |
|
2752 + newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL |
|
2753 + newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL |
|
2754 + newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL |
|
2755 + newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL |
|
2756 + newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL |
|
2757 + pv_display() NEED_pv_display NEED_pv_display_GLOBAL |
|
2758 + pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL |
|
2759 + pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL |
|
2760 + sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL |
|
2761 + sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL |
|
2762 + sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL |
|
2763 + sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL |
|
2764 + sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL |
|
2765 + sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL |
|
2766 + sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL |
|
2767 + vload_module() NEED_vload_module NEED_vload_module_GLOBAL |
|
2768 + vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL |
|
2769 + warner() NEED_warner NEED_warner_GLOBAL |
|
2770 + |
|
2771 +To avoid namespace conflicts, you can change the namespace of the |
|
2772 +explicitly exported functions / variables using the C<DPPP_NAMESPACE> |
|
2773 +macro. Just C<#define> the macro before including C<ppport.h>: |
|
2774 + |
|
2775 + #define DPPP_NAMESPACE MyOwnNamespace_ |
|
2776 + #include "ppport.h" |
|
2777 + |
|
2778 +The default namespace is C<DPPP_>. |
|
2779 + |
|
2780 +=back |
|
2781 + |
|
2782 +The good thing is that most of the above can be checked by running |
|
2783 +F<ppport.h> on your source code. See the next section for |
|
2784 +details. |
|
2785 + |
|
2786 +=head1 EXAMPLES |
|
2787 + |
|
2788 +To verify whether F<ppport.h> is needed for your module, whether you |
|
2789 +should make any changes to your code, and whether any special defines |
|
2790 +should be used, F<ppport.h> can be run as a Perl script to check your |
|
2791 +source code. Simply say: |
|
2792 + |
|
2793 + perl ppport.h |
|
2794 + |
|
2795 +The result will usually be a list of patches suggesting changes |
|
2796 +that should at least be acceptable, if not necessarily the most |
|
2797 +efficient solution, or a fix for all possible problems. |
|
2798 + |
|
2799 +If you know that your XS module uses features only available in |
|
2800 +newer Perl releases, if you're aware that it uses C++ comments, |
|
2801 +and if you want all suggestions as a single patch file, you could |
|
2802 +use something like this: |
|
2803 + |
|
2804 + perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff |
|
2805 + |
|
2806 +If you only want your code to be scanned without any suggestions |
|
2807 +for changes, use: |
|
2808 + |
|
2809 + perl ppport.h --nochanges |
|
2810 + |
|
2811 +You can specify a different C<diff> program or options, using |
|
2812 +the C<--diff> option: |
|
2813 + |
|
2814 + perl ppport.h --diff='diff -C 10' |
|
2815 + |
|
2816 +This would output context diffs with 10 lines of context. |
|
2817 + |
|
2818 +If you want to create patched copies of your files instead, use: |
|
2819 + |
|
2820 + perl ppport.h --copy=.new |
|
2821 + |
|
2822 +To display portability information for the C<newSVpvn> function, |
|
2823 +use: |
|
2824 + |
|
2825 + perl ppport.h --api-info=newSVpvn |
|
2826 + |
|
2827 +Since the argument to C<--api-info> can be a regular expression, |
|
2828 +you can use |
|
2829 + |
|
2830 + perl ppport.h --api-info=/_nomg$/ |
|
2831 + |
|
2832 +to display portability information for all C<_nomg> functions or |
|
2833 + |
|
2834 + perl ppport.h --api-info=/./ |
|
2835 + |
|
2836 +to display information for all known API elements. |
|
2837 + |
|
2838 +=head1 BUGS |
|
2839 + |
|
2840 +If this version of F<ppport.h> is causing failure during |
|
2841 +the compilation of this module, please check if newer versions |
|
2842 +of either this module or C<Devel::PPPort> are available on CPAN |
|
2843 +before sending a bug report. |
|
2844 + |
|
2845 +If F<ppport.h> was generated using the latest version of |
|
2846 +C<Devel::PPPort> and is causing failure of this module, please |
|
2847 +file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>. |
|
2848 + |
|
2849 +Please include the following information: |
|
2850 + |
|
2851 +=over 4 |
|
2852 + |
|
2853 +=item 1. |
|
2854 + |
|
2855 +The complete output from running "perl -V" |
|
2856 + |
|
2857 +=item 2. |
|
2858 + |
|
2859 +This file. |
|
2860 + |
|
2861 +=item 3. |
|
2862 + |
|
2863 +The name and version of the module you were trying to build. |
|
2864 + |
|
2865 +=item 4. |
|
2866 + |
|
2867 +A full log of the build that failed. |
|
2868 + |
|
2869 +=item 5. |
|
2870 + |
|
2871 +Any other information that you think could be relevant. |
|
2872 + |
|
2873 +=back |
|
2874 + |
|
2875 +For the latest version of this code, please get the C<Devel::PPPort> |
|
2876 +module from CPAN. |
|
2877 + |
|
2878 +=head1 COPYRIGHT |
|
2879 + |
|
2880 +Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz. |
|
2881 + |
|
2882 +Version 2.x, Copyright (C) 2001, Paul Marquess. |
|
2883 + |
|
2884 +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
|
2885 + |
|
2886 +This program is free software; you can redistribute it and/or |
|
2887 +modify it under the same terms as Perl itself. |
|
2888 + |
|
2889 +=head1 SEE ALSO |
|
2890 + |
|
2891 +See L<Devel::PPPort>. |
|
2892 + |
|
2893 +=cut |
|
2894 + |
|
2895 +use strict; |
|
2896 + |
|
2897 +# Disable broken TRIE-optimization |
|
2898 +BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 } |
|
2899 + |
|
2900 +my $VERSION = 3.21; |
|
2901 + |
|
2902 +my %opt = ( |
|
2903 + quiet => 0, |
|
2904 + diag => 1, |
|
2905 + hints => 1, |
|
2906 + changes => 1, |
|
2907 + cplusplus => 0, |
|
2908 + filter => 1, |
|
2909 + strip => 0, |
|
2910 + version => 0, |
|
2911 +); |
|
2912 + |
|
2913 +my($ppport) = $0 =~ /([\w.]+)$/; |
|
2914 +my $LF = '(?:\r\n|[\r\n])'; # line feed |
|
2915 +my $HS = "[ \t]"; # horizontal whitespace |
|
2916 + |
|
2917 +# Never use C comments in this file! |
|
2918 +my $ccs = '/'.'*'; |
|
2919 +my $cce = '*'.'/'; |
|
2920 +my $rccs = quotemeta $ccs; |
|
2921 +my $rcce = quotemeta $cce; |
|
2922 + |
|
2923 +eval { |
|
2924 + require Getopt::Long; |
|
2925 + Getopt::Long::GetOptions(\%opt, qw( |
|
2926 + help quiet diag! filter! hints! changes! cplusplus strip version |
|
2927 + patch=s copy=s diff=s compat-version=s |
|
2928 + list-provided list-unsupported api-info=s |
|
2929 + )) or usage(); |
|
2930 +}; |
|
2931 + |
|
2932 +if ($@ and grep /^-/, @ARGV) { |
|
2933 + usage() if "@ARGV" =~ /^--?h(?:elp)?$/; |
|
2934 + die "Getopt::Long not found. Please don't use any options.\n"; |
|
2935 +} |
|
2936 + |
|
2937 +if ($opt{version}) { |
|
2938 + print "This is $0 $VERSION.\n"; |
|
2939 + exit 0; |
|
2940 +} |
|
2941 + |
|
2942 +usage() if $opt{help}; |
|
2943 +strip() if $opt{strip}; |
|
2944 + |
|
2945 +if (exists $opt{'compat-version'}) { |
|
2946 + my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; |
|
2947 + if ($@) { |
|
2948 + die "Invalid version number format: '$opt{'compat-version'}'\n"; |
|
2949 + } |
|
2950 + die "Only Perl 5 is supported\n" if $r != 5; |
|
2951 + die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; |
|
2952 + $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; |
|
2953 +} |
|
2954 +else { |
|
2955 + $opt{'compat-version'} = 5; |
|
2956 +} |
|
2957 + |
|
2958 +my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ |
|
2959 + ? ( $1 => { |
|
2960 + ($2 ? ( base => $2 ) : ()), |
|
2961 + ($3 ? ( todo => $3 ) : ()), |
|
2962 + (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), |
|
2963 + (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), |
|
2964 + (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), |
|
2965 + } ) |
|
2966 + : die "invalid spec: $_" } qw( |
|
2967 +AvFILLp|5.004050||p |
|
2968 +AvFILL||| |
|
2969 +BhkDISABLE||5.019003| |
|
2970 +BhkENABLE||5.019003| |
|
2971 +BhkENTRY_set||5.019003| |
|
2972 +BhkENTRY||| |
|
2973 +BhkFLAGS||| |
|
2974 +CALL_BLOCK_HOOKS||| |
|
2975 +CLASS|||n |
|
2976 +CPERLscope|5.005000||p |
|
2977 +CX_CURPAD_SAVE||| |
|
2978 +CX_CURPAD_SV||| |
|
2979 +CopFILEAV|5.006000||p |
|
2980 +CopFILEGV_set|5.006000||p |
|
2981 +CopFILEGV|5.006000||p |
|
2982 +CopFILESV|5.006000||p |
|
2983 +CopFILE_set|5.006000||p |
|
2984 +CopFILE|5.006000||p |
|
2985 +CopSTASHPV_set|5.006000||p |
|
2986 +CopSTASHPV|5.006000||p |
|
2987 +CopSTASH_eq|5.006000||p |
|
2988 +CopSTASH_set|5.006000||p |
|
2989 +CopSTASH|5.006000||p |
|
2990 +CopyD|5.009002|5.004050|p |
|
2991 +Copy||5.004050| |
|
2992 +CvPADLIST||5.008001| |
|
2993 +CvSTASH||| |
|
2994 +CvWEAKOUTSIDE||| |
|
2995 +DEFSV_set|5.010001||p |
|
2996 +DEFSV|5.004050||p |
|
2997 +END_EXTERN_C|5.005000||p |
|
2998 +ENTER||| |
|
2999 +ERRSV|5.004050||p |
|
3000 +EXTEND||| |
|
3001 +EXTERN_C|5.005000||p |
|
3002 +F0convert|||n |
|
3003 +FREETMPS||| |
|
3004 +GIMME_V||5.004000|n |
|
3005 +GIMME|||n |
|
3006 +GROK_NUMERIC_RADIX|5.007002||p |
|
3007 +G_ARRAY||| |
|
3008 +G_DISCARD||| |
|
3009 +G_EVAL||| |
|
3010 +G_METHOD|5.006001||p |
|
3011 +G_NOARGS||| |
|
3012 +G_SCALAR||| |
|
3013 +G_VOID||5.004000| |
|
3014 +GetVars||| |
|
3015 +GvAV||| |
|
3016 +GvCV||| |
|
3017 +GvHV||| |
|
3018 +GvSVn|5.009003||p |
|
3019 +GvSV||| |
|
3020 +Gv_AMupdate||5.011000| |
|
3021 +HEf_SVKEY||5.004000| |
|
3022 +HeHASH||5.004000| |
|
3023 +HeKEY||5.004000| |
|
3024 +HeKLEN||5.004000| |
|
3025 +HePV||5.004000| |
|
3026 +HeSVKEY_force||5.004000| |
|
3027 +HeSVKEY_set||5.004000| |
|
3028 +HeSVKEY||5.004000| |
|
3029 +HeUTF8||5.010001| |
|
3030 +HeVAL||5.004000| |
|
3031 +HvENAMELEN||5.015004| |
|
3032 +HvENAMEUTF8||5.015004| |
|
3033 +HvENAME||5.013007| |
|
3034 +HvNAMELEN_get|5.009003||p |
|
3035 +HvNAMELEN||5.015004| |
|
3036 +HvNAMEUTF8||5.015004| |
|
3037 +HvNAME_get|5.009003||p |
|
3038 +HvNAME||| |
|
3039 +INT2PTR|5.006000||p |
|
3040 +IN_LOCALE_COMPILETIME|5.007002||p |
|
3041 +IN_LOCALE_RUNTIME|5.007002||p |
|
3042 +IN_LOCALE|5.007002||p |
|
3043 +IN_PERL_COMPILETIME|5.008001||p |
|
3044 +IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p |
|
3045 +IS_NUMBER_INFINITY|5.007002||p |
|
3046 +IS_NUMBER_IN_UV|5.007002||p |
|
3047 +IS_NUMBER_NAN|5.007003||p |
|
3048 +IS_NUMBER_NEG|5.007002||p |
|
3049 +IS_NUMBER_NOT_INT|5.007002||p |
|
3050 +IVSIZE|5.006000||p |
|
3051 +IVTYPE|5.006000||p |
|
3052 +IVdf|5.006000||p |
|
3053 +LEAVE||| |
|
3054 +LINKLIST||5.013006| |
|
3055 +LVRET||| |
|
3056 +MARK||| |
|
3057 +MULTICALL||5.019003| |
|
3058 +MY_CXT_CLONE|5.009002||p |
|
3059 +MY_CXT_INIT|5.007003||p |
|
3060 +MY_CXT|5.007003||p |
|
3061 +MoveD|5.009002|5.004050|p |
|
3062 +Move||5.004050| |
|
3063 +NOOP|5.005000||p |
|
3064 +NUM2PTR|5.006000||p |
|
3065 +NVTYPE|5.006000||p |
|
3066 +NVef|5.006001||p |
|
3067 +NVff|5.006001||p |
|
3068 +NVgf|5.006001||p |
|
3069 +Newxc|5.009003||p |
|
3070 +Newxz|5.009003||p |
|
3071 +Newx|5.009003||p |
|
3072 +Nullav||| |
|
3073 +Nullch||| |
|
3074 +Nullcv||| |
|
3075 +Nullhv||| |
|
3076 +Nullsv||| |
|
3077 +OP_CLASS||5.013007| |
|
3078 +OP_DESC||5.007003| |
|
3079 +OP_NAME||5.007003| |
|
3080 +ORIGMARK||| |
|
3081 +PAD_BASE_SV||| |
|
3082 +PAD_CLONE_VARS||| |
|
3083 +PAD_COMPNAME_FLAGS||| |
|
3084 +PAD_COMPNAME_GEN_set||| |
|
3085 +PAD_COMPNAME_GEN||| |
|
3086 +PAD_COMPNAME_OURSTASH||| |
|
3087 +PAD_COMPNAME_PV||| |
|
3088 +PAD_COMPNAME_TYPE||| |
|
3089 +PAD_RESTORE_LOCAL||| |
|
3090 +PAD_SAVE_LOCAL||| |
|
3091 +PAD_SAVE_SETNULLPAD||| |
|
3092 +PAD_SETSV||| |
|
3093 +PAD_SET_CUR_NOSAVE||| |
|
3094 +PAD_SET_CUR||| |
|
3095 +PAD_SVl||| |
|
3096 +PAD_SV||| |
|
3097 +PERLIO_FUNCS_CAST|5.009003||p |
|
3098 +PERLIO_FUNCS_DECL|5.009003||p |
|
3099 +PERL_ABS|5.008001||p |
|
3100 +PERL_BCDVERSION|5.019002||p |
|
3101 +PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p |
|
3102 +PERL_HASH|5.004000||p |
|
3103 +PERL_INT_MAX|5.004000||p |
|
3104 +PERL_INT_MIN|5.004000||p |
|
3105 +PERL_LONG_MAX|5.004000||p |
|
3106 +PERL_LONG_MIN|5.004000||p |
|
3107 +PERL_MAGIC_arylen|5.007002||p |
|
3108 +PERL_MAGIC_backref|5.007002||p |
|
3109 +PERL_MAGIC_bm|5.007002||p |
|
3110 +PERL_MAGIC_collxfrm|5.007002||p |
|
3111 +PERL_MAGIC_dbfile|5.007002||p |
|
3112 +PERL_MAGIC_dbline|5.007002||p |
|
3113 +PERL_MAGIC_defelem|5.007002||p |
|
3114 +PERL_MAGIC_envelem|5.007002||p |
|
3115 +PERL_MAGIC_env|5.007002||p |
|
3116 +PERL_MAGIC_ext|5.007002||p |
|
3117 +PERL_MAGIC_fm|5.007002||p |
|
3118 +PERL_MAGIC_glob|5.019002||p |
|
3119 +PERL_MAGIC_isaelem|5.007002||p |
|
3120 +PERL_MAGIC_isa|5.007002||p |
|
3121 +PERL_MAGIC_mutex|5.019002||p |
|
3122 +PERL_MAGIC_nkeys|5.007002||p |
|
3123 +PERL_MAGIC_overload_elem|5.019002||p |
|
3124 +PERL_MAGIC_overload_table|5.007002||p |
|
3125 +PERL_MAGIC_overload|5.019002||p |
|
3126 +PERL_MAGIC_pos|5.007002||p |
|
3127 +PERL_MAGIC_qr|5.007002||p |
|
3128 +PERL_MAGIC_regdata|5.007002||p |
|
3129 +PERL_MAGIC_regdatum|5.007002||p |
|
3130 +PERL_MAGIC_regex_global|5.007002||p |
|
3131 +PERL_MAGIC_shared_scalar|5.007003||p |
|
3132 +PERL_MAGIC_shared|5.007003||p |
|
3133 +PERL_MAGIC_sigelem|5.007002||p |
|
3134 +PERL_MAGIC_sig|5.007002||p |
|
3135 +PERL_MAGIC_substr|5.007002||p |
|
3136 +PERL_MAGIC_sv|5.007002||p |
|
3137 +PERL_MAGIC_taint|5.007002||p |
|
3138 +PERL_MAGIC_tiedelem|5.007002||p |
|
3139 +PERL_MAGIC_tiedscalar|5.007002||p |
|
3140 +PERL_MAGIC_tied|5.007002||p |
|
3141 +PERL_MAGIC_utf8|5.008001||p |
|
3142 +PERL_MAGIC_uvar_elem|5.007003||p |
|
3143 +PERL_MAGIC_uvar|5.007002||p |
|
3144 +PERL_MAGIC_vec|5.007002||p |
|
3145 +PERL_MAGIC_vstring|5.008001||p |
|
3146 +PERL_PV_ESCAPE_ALL|5.009004||p |
|
3147 +PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p |
|
3148 +PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p |
|
3149 +PERL_PV_ESCAPE_NOCLEAR|5.009004||p |
|
3150 +PERL_PV_ESCAPE_QUOTE|5.009004||p |
|
3151 +PERL_PV_ESCAPE_RE|5.009005||p |
|
3152 +PERL_PV_ESCAPE_UNI_DETECT|5.009004||p |
|
3153 +PERL_PV_ESCAPE_UNI|5.009004||p |
|
3154 +PERL_PV_PRETTY_DUMP|5.009004||p |
|
3155 +PERL_PV_PRETTY_ELLIPSES|5.010000||p |
|
3156 +PERL_PV_PRETTY_LTGT|5.009004||p |
|
3157 +PERL_PV_PRETTY_NOCLEAR|5.010000||p |
|
3158 +PERL_PV_PRETTY_QUOTE|5.009004||p |
|
3159 +PERL_PV_PRETTY_REGPROP|5.009004||p |
|
3160 +PERL_QUAD_MAX|5.004000||p |
|
3161 +PERL_QUAD_MIN|5.004000||p |
|
3162 +PERL_REVISION|5.006000||p |
|
3163 +PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p |
|
3164 +PERL_SCAN_DISALLOW_PREFIX|5.007003||p |
|
3165 +PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p |
|
3166 +PERL_SCAN_SILENT_ILLDIGIT|5.008001||p |
|
3167 +PERL_SHORT_MAX|5.004000||p |
|
3168 +PERL_SHORT_MIN|5.004000||p |
|
3169 +PERL_SIGNALS_UNSAFE_FLAG|5.008001||p |
|
3170 +PERL_SUBVERSION|5.006000||p |
|
3171 +PERL_SYS_INIT3||5.010000| |
|
3172 +PERL_SYS_INIT||5.010000| |
|
3173 +PERL_SYS_TERM||5.019003| |
|
3174 +PERL_UCHAR_MAX|5.004000||p |
|
3175 +PERL_UCHAR_MIN|5.004000||p |
|
3176 +PERL_UINT_MAX|5.004000||p |
|
3177 +PERL_UINT_MIN|5.004000||p |
|
3178 +PERL_ULONG_MAX|5.004000||p |
|
3179 +PERL_ULONG_MIN|5.004000||p |
|
3180 +PERL_UNUSED_ARG|5.009003||p |
|
3181 +PERL_UNUSED_CONTEXT|5.009004||p |
|
3182 +PERL_UNUSED_DECL|5.007002||p |
|
3183 +PERL_UNUSED_VAR|5.007002||p |
|
3184 +PERL_UQUAD_MAX|5.004000||p |
|
3185 +PERL_UQUAD_MIN|5.004000||p |
|
3186 +PERL_USE_GCC_BRACE_GROUPS|5.009004||p |
|
3187 +PERL_USHORT_MAX|5.004000||p |
|
3188 +PERL_USHORT_MIN|5.004000||p |
|
3189 +PERL_VERSION|5.006000||p |
|
3190 +PL_DBsignal|5.005000||p |
|
3191 +PL_DBsingle|||pn |
|
3192 +PL_DBsub|||pn |
|
3193 +PL_DBtrace|||pn |
|
3194 +PL_Sv|5.005000||p |
|
3195 +PL_bufend|5.019002||p |
|
3196 +PL_bufptr|5.019002||p |
|
3197 +PL_check||5.006000| |
|
3198 +PL_compiling|5.004050||p |
|
3199 +PL_comppad_name||5.017004| |
|
3200 +PL_comppad||5.008001| |
|
3201 +PL_copline|5.019002||p |
|
3202 +PL_curcop|5.004050||p |
|
3203 +PL_curpad||5.005000| |
|
3204 +PL_curstash|5.004050||p |
|
3205 +PL_debstash|5.004050||p |
|
3206 +PL_defgv|5.004050||p |
|
3207 +PL_diehook|5.004050||p |
|
3208 +PL_dirty|5.004050||p |
|
3209 +PL_dowarn|||pn |
|
3210 +PL_errgv|5.004050||p |
|
3211 +PL_error_count|5.019002||p |
|
3212 +PL_expect|5.019002||p |
|
3213 +PL_hexdigit|5.005000||p |
|
3214 +PL_hints|5.005000||p |
|
3215 +PL_in_my_stash|5.019002||p |
|
3216 +PL_in_my|5.019002||p |
|
3217 +PL_keyword_plugin||5.011002| |
|
3218 +PL_last_in_gv|||n |
|
3219 +PL_laststatval|5.005000||p |
|
3220 +PL_lex_state|5.019002||p |
|
3221 +PL_lex_stuff|5.019002||p |
|
3222 +PL_linestr|5.019002||p |
|
3223 +PL_modglobal||5.005000|n |
|
3224 +PL_na|5.004050||pn |
|
3225 +PL_no_modify|5.006000||p |
|
3226 +PL_ofsgv|||n |
|
3227 +PL_opfreehook||5.011000|n |
|
3228 +PL_parser|5.009005|5.009005|p |
|
3229 +PL_peepp||5.007003|n |
|
3230 +PL_perl_destruct_level|5.004050||p |
|
3231 +PL_perldb|5.004050||p |
|
3232 +PL_ppaddr|5.006000||p |
|
3233 +PL_rpeepp||5.013005|n |
|
3234 +PL_rsfp_filters|5.019002||p |
|
3235 +PL_rsfp|5.019002||p |
|
3236 +PL_rs|||n |
|
3237 +PL_signals|5.008001||p |
|
3238 +PL_stack_base|5.004050||p |
|
3239 +PL_stack_sp|5.004050||p |
|
3240 +PL_statcache|5.005000||p |
|
3241 +PL_stdingv|5.004050||p |
|
3242 +PL_sv_arenaroot|5.004050||p |
|
3243 +PL_sv_no|5.004050||pn |
|
3244 +PL_sv_undef|5.004050||pn |
|
3245 +PL_sv_yes|5.004050||pn |
|
3246 +PL_tainted|5.004050||p |
|
3247 +PL_tainting|5.004050||p |
|
3248 +PL_tokenbuf|5.019002||p |
|
3249 +POP_MULTICALL||5.019003| |
|
3250 +POPi|||n |
|
3251 +POPl|||n |
|
3252 +POPn|||n |
|
3253 +POPpbytex||5.007001|n |
|
3254 +POPpx||5.005030|n |
|
3255 +POPp|||n |
|
3256 +POPs|||n |
|
3257 +PTR2IV|5.006000||p |
|
3258 +PTR2NV|5.006000||p |
|
3259 +PTR2UV|5.006000||p |
|
3260 +PTR2nat|5.009003||p |
|
3261 +PTR2ul|5.007001||p |
|
3262 +PTRV|5.006000||p |
|
3263 +PUSHMARK||| |
|
3264 +PUSH_MULTICALL||5.019003| |
|
3265 +PUSHi||| |
|
3266 +PUSHmortal|5.009002||p |
|
3267 +PUSHn||| |
|
3268 +PUSHp||| |
|
3269 +PUSHs||| |
|
3270 +PUSHu|5.004000||p |
|
3271 +PUTBACK||| |
|
3272 +PadARRAY||5.019003| |
|
3273 +PadMAX||5.019003| |
|
3274 +PadlistARRAY||5.019003| |
|
3275 +PadlistMAX||5.019003| |
|
3276 +PadlistNAMESARRAY||5.019003| |
|
3277 +PadlistNAMESMAX||5.019003| |
|
3278 +PadlistNAMES||5.019003| |
|
3279 +PadlistREFCNT||5.017004| |
|
3280 +PadnameIsOUR||| |
|
3281 +PadnameIsSTATE||| |
|
3282 +PadnameLEN||5.019003| |
|
3283 +PadnameOURSTASH||| |
|
3284 +PadnameOUTER||| |
|
3285 +PadnamePV||5.019003| |
|
3286 +PadnameSV||5.019003| |
|
3287 +PadnameTYPE||| |
|
3288 +PadnameUTF8||5.019003| |
|
3289 +PadnamelistARRAY||5.019003| |
|
3290 +PadnamelistMAX||5.019003| |
|
3291 +PerlIO_clearerr||5.007003| |
|
3292 +PerlIO_close||5.007003| |
|
3293 +PerlIO_context_layers||5.009004| |
|
3294 +PerlIO_eof||5.007003| |
|
3295 +PerlIO_error||5.007003| |
|
3296 +PerlIO_fileno||5.007003| |
|
3297 +PerlIO_fill||5.007003| |
|
3298 +PerlIO_flush||5.007003| |
|
3299 +PerlIO_get_base||5.007003| |
|
3300 +PerlIO_get_bufsiz||5.007003| |
|
3301 +PerlIO_get_cnt||5.007003| |
|
3302 +PerlIO_get_ptr||5.007003| |
|
3303 +PerlIO_read||5.007003| |
|
3304 +PerlIO_seek||5.007003| |
|
3305 +PerlIO_set_cnt||5.007003| |
|
3306 +PerlIO_set_ptrcnt||5.007003| |
|
3307 +PerlIO_setlinebuf||5.007003| |
|
3308 +PerlIO_stderr||5.007003| |
|
3309 +PerlIO_stdin||5.007003| |
|
3310 +PerlIO_stdout||5.007003| |
|
3311 +PerlIO_tell||5.007003| |
|
3312 +PerlIO_unread||5.007003| |
|
3313 +PerlIO_write||5.007003| |
|
3314 +Perl_signbit||5.009005|n |
|
3315 +PoisonFree|5.009004||p |
|
3316 +PoisonNew|5.009004||p |
|
3317 +PoisonWith|5.009004||p |
|
3318 +Poison|5.008000||p |
|
3319 +READ_XDIGIT||5.017006| |
|
3320 +RETVAL|||n |
|
3321 +Renewc||| |
|
3322 +Renew||| |
|
3323 +SAVECLEARSV||| |
|
3324 +SAVECOMPPAD||| |
|
3325 +SAVEPADSV||| |
|
3326 +SAVETMPS||| |
|
3327 +SAVE_DEFSV|5.004050||p |
|
3328 +SPAGAIN||| |
|
3329 +SP||| |
|
3330 +START_EXTERN_C|5.005000||p |
|
3331 +START_MY_CXT|5.007003||p |
|
3332 +STMT_END|||p |
|
3333 +STMT_START|||p |
|
3334 +STR_WITH_LEN|5.009003||p |
|
3335 +ST||| |
|
3336 +SV_CONST_RETURN|5.009003||p |
|
3337 +SV_COW_DROP_PV|5.008001||p |
|
3338 +SV_COW_SHARED_HASH_KEYS|5.009005||p |
|
3339 +SV_GMAGIC|5.007002||p |
|
3340 +SV_HAS_TRAILING_NUL|5.009004||p |
|
3341 +SV_IMMEDIATE_UNREF|5.007001||p |
|
3342 +SV_MUTABLE_RETURN|5.009003||p |
|
3343 +SV_NOSTEAL|5.009002||p |
|
3344 +SV_SMAGIC|5.009003||p |
|
3345 +SV_UTF8_NO_ENCODING|5.008001||p |
|
3346 +SVfARG|5.009005||p |
|
3347 +SVf_UTF8|5.006000||p |
|
3348 +SVf|5.006000||p |
|
3349 +SVt_INVLIST||5.019002| |
|
3350 +SVt_IV||| |
|
3351 +SVt_NULL||| |
|
3352 +SVt_NV||| |
|
3353 +SVt_PVAV||| |
|
3354 +SVt_PVCV||| |
|
3355 +SVt_PVFM||| |
|
3356 +SVt_PVGV||| |
|
3357 +SVt_PVHV||| |
|
3358 +SVt_PVIO||| |
|
3359 +SVt_PVIV||| |
|
3360 +SVt_PVLV||| |
|
3361 +SVt_PVMG||| |
|
3362 +SVt_PVNV||| |
|
3363 +SVt_PV||| |
|
3364 +SVt_REGEXP||5.011000| |
|
3365 +Safefree||| |
|
3366 +Slab_Alloc||| |
|
3367 +Slab_Free||| |
|
3368 +Slab_to_ro||| |
|
3369 +Slab_to_rw||| |
|
3370 +StructCopy||| |
|
3371 +SvCUR_set||| |
|
3372 +SvCUR||| |
|
3373 +SvEND||| |
|
3374 +SvGAMAGIC||5.006001| |
|
3375 +SvGETMAGIC|5.004050||p |
|
3376 +SvGROW||| |
|
3377 +SvIOK_UV||5.006000| |
|
3378 +SvIOK_notUV||5.006000| |
|
3379 +SvIOK_off||| |
|
3380 +SvIOK_only_UV||5.006000| |
|
3381 +SvIOK_only||| |
|
3382 +SvIOK_on||| |
|
3383 +SvIOKp||| |
|
3384 +SvIOK||| |
|
3385 +SvIVX||| |
|
3386 +SvIV_nomg|5.009001||p |
|
3387 +SvIV_set||| |
|
3388 +SvIVx||| |
|
3389 +SvIV||| |
|
3390 +SvIsCOW_shared_hash||5.008003| |
|
3391 +SvIsCOW||5.008003| |
|
3392 +SvLEN_set||| |
|
3393 +SvLEN||| |
|
3394 +SvLOCK||5.007003| |
|
3395 +SvMAGIC_set|5.009003||p |
|
3396 +SvNIOK_off||| |
|
3397 +SvNIOKp||| |
|
3398 +SvNIOK||| |
|
3399 +SvNOK_off||| |
|
3400 +SvNOK_only||| |
|
3401 +SvNOK_on||| |
|
3402 +SvNOKp||| |
|
3403 +SvNOK||| |
|
3404 +SvNVX||| |
|
3405 +SvNV_nomg||5.013002| |
|
3406 +SvNV_set||| |
|
3407 +SvNVx||| |
|
3408 +SvNV||| |
|
3409 +SvOK||| |
|
3410 +SvOOK_offset||5.011000| |
|
3411 +SvOOK||| |
|
3412 +SvPOK_off||| |
|
3413 +SvPOK_only_UTF8||5.006000| |
|
3414 +SvPOK_only||| |
|
3415 +SvPOK_on||| |
|
3416 +SvPOKp||| |
|
3417 +SvPOK||| |
|
3418 +SvPVX_const|5.009003||p |
|
3419 +SvPVX_mutable|5.009003||p |
|
3420 +SvPVX||| |
|
3421 +SvPV_const|5.009003||p |
|
3422 +SvPV_flags_const_nolen|5.009003||p |
|
3423 +SvPV_flags_const|5.009003||p |
|
3424 +SvPV_flags_mutable|5.009003||p |
|
3425 +SvPV_flags|5.007002||p |
|
3426 +SvPV_force_flags_mutable|5.009003||p |
|
3427 +SvPV_force_flags_nolen|5.009003||p |
|
3428 +SvPV_force_flags|5.007002||p |
|
3429 +SvPV_force_mutable|5.009003||p |
|
3430 +SvPV_force_nolen|5.009003||p |
|
3431 +SvPV_force_nomg_nolen|5.009003||p |
|
3432 +SvPV_force_nomg|5.007002||p |
|
3433 +SvPV_force|||p |
|
3434 +SvPV_mutable|5.009003||p |
|
3435 +SvPV_nolen_const|5.009003||p |
|
3436 +SvPV_nolen|5.006000||p |
|
3437 +SvPV_nomg_const_nolen|5.009003||p |
|
3438 +SvPV_nomg_const|5.009003||p |
|
3439 +SvPV_nomg_nolen|5.013007||p |
|
3440 +SvPV_nomg|5.007002||p |
|
3441 +SvPV_renew|5.009003||p |
|
3442 +SvPV_set||| |
|
3443 +SvPVbyte_force||5.009002| |
|
3444 +SvPVbyte_nolen||5.006000| |
|
3445 +SvPVbytex_force||5.006000| |
|
3446 +SvPVbytex||5.006000| |
|
3447 +SvPVbyte|5.006000||p |
|
3448 +SvPVutf8_force||5.006000| |
|
3449 +SvPVutf8_nolen||5.006000| |
|
3450 +SvPVutf8x_force||5.006000| |
|
3451 +SvPVutf8x||5.006000| |
|
3452 +SvPVutf8||5.006000| |
|
3453 +SvPVx||| |
|
3454 +SvPV||| |
|
3455 +SvREFCNT_dec_NN||5.017007| |
|
3456 +SvREFCNT_dec||| |
|
3457 +SvREFCNT_inc_NN|5.009004||p |
|
3458 +SvREFCNT_inc_simple_NN|5.009004||p |
|
3459 +SvREFCNT_inc_simple_void_NN|5.009004||p |
|
3460 +SvREFCNT_inc_simple_void|5.009004||p |
|
3461 +SvREFCNT_inc_simple|5.009004||p |
|
3462 +SvREFCNT_inc_void_NN|5.009004||p |
|
3463 +SvREFCNT_inc_void|5.009004||p |
|
3464 +SvREFCNT_inc|||p |
|
3465 +SvREFCNT||| |
|
3466 +SvROK_off||| |
|
3467 +SvROK_on||| |
|
3468 +SvROK||| |
|
3469 +SvRV_set|5.009003||p |
|
3470 +SvRV||| |
|
3471 +SvRXOK||5.009005| |
|
3472 +SvRX||5.009005| |
|
3473 +SvSETMAGIC||| |
|
3474 +SvSHARED_HASH|5.009003||p |
|
3475 +SvSHARE||5.007003| |
|
3476 +SvSTASH_set|5.009003||p |
|
3477 +SvSTASH||| |
|
3478 +SvSetMagicSV_nosteal||5.004000| |
|
3479 +SvSetMagicSV||5.004000| |
|
3480 +SvSetSV_nosteal||5.004000| |
|
3481 +SvSetSV||| |
|
3482 +SvTAINTED_off||5.004000| |
|
3483 +SvTAINTED_on||5.004000| |
|
3484 +SvTAINTED||5.004000| |
|
3485 +SvTAINT||| |
|
3486 +SvTHINKFIRST||| |
|
3487 +SvTRUE_nomg||5.013006| |
|
3488 +SvTRUE||| |
|
3489 +SvTYPE||| |
|
3490 +SvUNLOCK||5.007003| |
|
3491 +SvUOK|5.007001|5.006000|p |
|
3492 +SvUPGRADE||| |
|
3493 +SvUTF8_off||5.006000| |
|
3494 +SvUTF8_on||5.006000| |
|
3495 +SvUTF8||5.006000| |
|
3496 +SvUVXx|5.004000||p |
|
3497 +SvUVX|5.004000||p |
|
3498 +SvUV_nomg|5.009001||p |
|
3499 +SvUV_set|5.009003||p |
|
3500 +SvUVx|5.004000||p |
|
3501 +SvUV|5.004000||p |
|
3502 +SvVOK||5.008001| |
|
3503 +SvVSTRING_mg|5.009004||p |
|
3504 +THIS|||n |
|
3505 +UNDERBAR|5.009002||p |
|
3506 +UTF8_MAXBYTES|5.009002||p |
|
3507 +UVSIZE|5.006000||p |
|
3508 +UVTYPE|5.006000||p |
|
3509 +UVXf|5.007001||p |
|
3510 +UVof|5.006000||p |
|
3511 +UVuf|5.006000||p |
|
3512 +UVxf|5.006000||p |
|
3513 +WARN_ALL|5.006000||p |
|
3514 +WARN_AMBIGUOUS|5.006000||p |
|
3515 +WARN_ASSERTIONS|5.019002||p |
|
3516 +WARN_BAREWORD|5.006000||p |
|
3517 +WARN_CLOSED|5.006000||p |
|
3518 +WARN_CLOSURE|5.006000||p |
|
3519 +WARN_DEBUGGING|5.006000||p |
|
3520 +WARN_DEPRECATED|5.006000||p |
|
3521 +WARN_DIGIT|5.006000||p |
|
3522 +WARN_EXEC|5.006000||p |
|
3523 +WARN_EXITING|5.006000||p |
|
3524 +WARN_GLOB|5.006000||p |
|
3525 +WARN_INPLACE|5.006000||p |
|
3526 +WARN_INTERNAL|5.006000||p |
|
3527 +WARN_IO|5.006000||p |
|
3528 +WARN_LAYER|5.008000||p |
|
3529 +WARN_MALLOC|5.006000||p |
|
3530 +WARN_MISC|5.006000||p |
|
3531 +WARN_NEWLINE|5.006000||p |
|
3532 +WARN_NUMERIC|5.006000||p |
|
3533 +WARN_ONCE|5.006000||p |
|
3534 +WARN_OVERFLOW|5.006000||p |
|
3535 +WARN_PACK|5.006000||p |
|
3536 +WARN_PARENTHESIS|5.006000||p |
|
3537 +WARN_PIPE|5.006000||p |
|
3538 +WARN_PORTABLE|5.006000||p |
|
3539 +WARN_PRECEDENCE|5.006000||p |
|
3540 +WARN_PRINTF|5.006000||p |
|
3541 +WARN_PROTOTYPE|5.006000||p |
|
3542 +WARN_QW|5.006000||p |
|
3543 +WARN_RECURSION|5.006000||p |
|
3544 +WARN_REDEFINE|5.006000||p |
|
3545 +WARN_REGEXP|5.006000||p |
|
3546 +WARN_RESERVED|5.006000||p |
|
3547 +WARN_SEMICOLON|5.006000||p |
|
3548 +WARN_SEVERE|5.006000||p |
|
3549 +WARN_SIGNAL|5.006000||p |
|
3550 +WARN_SUBSTR|5.006000||p |
|
3551 +WARN_SYNTAX|5.006000||p |
|
3552 +WARN_TAINT|5.006000||p |
|
3553 +WARN_THREADS|5.008000||p |
|
3554 +WARN_UNINITIALIZED|5.006000||p |
|
3555 +WARN_UNOPENED|5.006000||p |
|
3556 +WARN_UNPACK|5.006000||p |
|
3557 +WARN_UNTIE|5.006000||p |
|
3558 +WARN_UTF8|5.006000||p |
|
3559 +WARN_VOID|5.006000||p |
|
3560 +WIDEST_UTYPE|5.015004||p |
|
3561 +XCPT_CATCH|5.009002||p |
|
3562 +XCPT_RETHROW|5.009002|5.007001|p |
|
3563 +XCPT_TRY_END|5.009002|5.004000|p |
|
3564 +XCPT_TRY_START|5.009002|5.004000|p |
|
3565 +XPUSHi||| |
|
3566 +XPUSHmortal|5.009002||p |
|
3567 +XPUSHn||| |
|
3568 +XPUSHp||| |
|
3569 +XPUSHs||| |
|
3570 +XPUSHu|5.004000||p |
|
3571 +XSPROTO|5.010000||p |
|
3572 +XSRETURN_EMPTY||| |
|
3573 +XSRETURN_IV||| |
|
3574 +XSRETURN_NO||| |
|
3575 +XSRETURN_NV||| |
|
3576 +XSRETURN_PV||| |
|
3577 +XSRETURN_UNDEF||| |
|
3578 +XSRETURN_UV|5.008001||p |
|
3579 +XSRETURN_YES||| |
|
3580 +XSRETURN|||p |
|
3581 +XST_mIV||| |
|
3582 +XST_mNO||| |
|
3583 +XST_mNV||| |
|
3584 +XST_mPV||| |
|
3585 +XST_mUNDEF||| |
|
3586 +XST_mUV|5.008001||p |
|
3587 +XST_mYES||| |
|
3588 +XS_APIVERSION_BOOTCHECK||5.013004| |
|
3589 +XS_EXTERNAL||5.019003| |
|
3590 +XS_INTERNAL||5.019003| |
|
3591 +XS_VERSION_BOOTCHECK||| |
|
3592 +XS_VERSION||| |
|
3593 +XSprePUSH|5.006000||p |
|
3594 +XS||| |
|
3595 +XopDISABLE||5.019003| |
|
3596 +XopENABLE||5.019003| |
|
3597 +XopENTRY_set||5.019003| |
|
3598 +XopENTRY||5.019003| |
|
3599 +XopFLAGS||5.013007| |
|
3600 +ZeroD|5.009002||p |
|
3601 +Zero||| |
|
3602 +_aMY_CXT|5.007003||p |
|
3603 +_add_range_to_invlist||| |
|
3604 +_append_range_to_invlist||| |
|
3605 +_core_swash_init||| |
|
3606 +_get_swash_invlist||| |
|
3607 +_invlist_array_init||| |
|
3608 +_invlist_contains_cp||| |
|
3609 +_invlist_contents||| |
|
3610 +_invlist_dump||| |
|
3611 +_invlist_intersection_maybe_complement_2nd||| |
|
3612 +_invlist_intersection||| |
|
3613 +_invlist_invert_prop||| |
|
3614 +_invlist_invert||| |
|
3615 +_invlist_len||| |
|
3616 +_invlist_populate_swatch||| |
|
3617 +_invlist_search||| |
|
3618 +_invlist_subtract||| |
|
3619 +_invlist_union_maybe_complement_2nd||| |
|
3620 +_invlist_union||| |
|
3621 +_is_uni_FOO||5.017008| |
|
3622 +_is_uni_perl_idcont||5.017008| |
|
3623 +_is_uni_perl_idstart||5.017007| |
|
3624 +_is_utf8_FOO||5.017008| |
|
3625 +_is_utf8_mark||5.017008| |
|
3626 +_is_utf8_perl_idcont||5.017008| |
|
3627 +_is_utf8_perl_idstart||5.017007| |
|
3628 +_new_invlist_C_array||| |
|
3629 +_new_invlist||| |
|
3630 +_pMY_CXT|5.007003||p |
|
3631 +_swash_inversion_hash||| |
|
3632 +_swash_to_invlist||| |
|
3633 +_to_fold_latin1||| |
|
3634 +_to_uni_fold_flags||5.013011| |
|
3635 +_to_upper_title_latin1||| |
|
3636 +_to_utf8_fold_flags||5.015006| |
|
3637 +_to_utf8_lower_flags||5.015006| |
|
3638 +_to_utf8_title_flags||5.015006| |
|
3639 +_to_utf8_upper_flags||5.015006| |
|
3640 +aMY_CXT_|5.007003||p |
|
3641 +aMY_CXT|5.007003||p |
|
3642 +aTHXR_|5.019002||p |
|
3643 +aTHXR|5.019002||p |
|
3644 +aTHX_|5.006000||p |
|
3645 +aTHX|5.006000||p |
|
3646 +aassign_common_vars||| |
|
3647 +add_cp_to_invlist||| |
|
3648 +add_data|||n |
|
3649 +add_utf16_textfilter||| |
|
3650 +addmad||| |
|
3651 +adjust_size_and_find_bucket|||n |
|
3652 +adjust_stack_on_leave||| |
|
3653 +alloc_maybe_populate_EXACT||| |
|
3654 +alloccopstash||| |
|
3655 +allocmy||| |
|
3656 +amagic_call||| |
|
3657 +amagic_cmp_locale||| |
|
3658 +amagic_cmp||| |
|
3659 +amagic_deref_call||5.013007| |
|
3660 +amagic_i_ncmp||| |
|
3661 +amagic_is_enabled||| |
|
3662 +amagic_ncmp||| |
|
3663 +anonymise_cv_maybe||| |
|
3664 +any_dup||| |
|
3665 +ao||| |
|
3666 +append_madprops||| |
|
3667 +apply_attrs_my||| |
|
3668 +apply_attrs_string||5.006001| |
|
3669 +apply_attrs||| |
|
3670 +apply||| |
|
3671 +assert_uft8_cache_coherent||| |
|
3672 +atfork_lock||5.007003|n |
|
3673 +atfork_unlock||5.007003|n |
|
3674 +av_arylen_p||5.009003| |
|
3675 +av_clear||| |
|
3676 +av_create_and_push||5.009005| |
|
3677 +av_create_and_unshift_one||5.009005| |
|
3678 +av_delete||5.006000| |
|
3679 +av_exists||5.006000| |
|
3680 +av_extend_guts||| |
|
3681 +av_extend||| |
|
3682 +av_fetch||| |
|
3683 +av_fill||| |
|
3684 +av_iter_p||5.011000| |
|
3685 +av_len||| |
|
3686 +av_make||| |
|
3687 +av_pop||| |
|
3688 +av_push||| |
|
3689 +av_reify||| |
|
3690 +av_shift||| |
|
3691 +av_store||| |
|
3692 +av_tindex||5.017009| |
|
3693 +av_top_index||5.017009| |
|
3694 +av_undef||| |
|
3695 +av_unshift||| |
|
3696 +ax|||n |
|
3697 +bad_type_gv||| |
|
3698 +bad_type_pv||| |
|
3699 +bind_match||| |
|
3700 +block_end||| |
|
3701 +block_gimme||5.004000| |
|
3702 +block_start||| |
|
3703 +blockhook_register||5.013003| |
|
3704 +boolSV|5.004000||p |
|
3705 +boot_core_PerlIO||| |
|
3706 +boot_core_UNIVERSAL||| |
|
3707 +boot_core_mro||| |
|
3708 +bytes_cmp_utf8||5.013007| |
|
3709 +bytes_from_utf8||5.007001| |
|
3710 +bytes_to_uni|||n |
|
3711 +bytes_to_utf8||5.006001| |
|
3712 +call_argv|5.006000||p |
|
3713 +call_atexit||5.006000| |
|
3714 +call_list||5.004000| |
|
3715 +call_method|5.006000||p |
|
3716 +call_pv|5.006000||p |
|
3717 +call_sv|5.006000||p |
|
3718 +caller_cx||5.013005| |
|
3719 +calloc||5.007002|n |
|
3720 +cando||| |
|
3721 +cast_i32||5.006000| |
|
3722 +cast_iv||5.006000| |
|
3723 +cast_ulong||5.006000| |
|
3724 +cast_uv||5.006000| |
|
3725 +check_locale_boundary_crossing||| |
|
3726 +check_type_and_open||| |
|
3727 +check_uni||| |
|
3728 +check_utf8_print||| |
|
3729 +checkcomma||| |
|
3730 +ckWARN|5.006000||p |
|
3731 +ck_entersub_args_core||| |
|
3732 +ck_entersub_args_list||5.013006| |
|
3733 +ck_entersub_args_proto_or_list||5.013006| |
|
3734 +ck_entersub_args_proto||5.013006| |
|
3735 +ck_warner_d||5.011001|v |
|
3736 +ck_warner||5.011001|v |
|
3737 +ckwarn_common||| |
|
3738 +ckwarn_d||5.009003| |
|
3739 +ckwarn||5.009003| |
|
3740 +cl_and|||n |
|
3741 +cl_anything|||n |
|
3742 +cl_init|||n |
|
3743 +cl_is_anything|||n |
|
3744 +cl_or|||n |
|
3745 +clear_placeholders||| |
|
3746 +clone_params_del|||n |
|
3747 +clone_params_new|||n |
|
3748 +closest_cop||| |
|
3749 +compute_EXACTish||| |
|
3750 +convert||| |
|
3751 +cop_fetch_label||5.015001| |
|
3752 +cop_free||| |
|
3753 +cop_hints_2hv||5.013007| |
|
3754 +cop_hints_fetch_pvn||5.013007| |
|
3755 +cop_hints_fetch_pvs||5.013007| |
|
3756 +cop_hints_fetch_pv||5.013007| |
|
3757 +cop_hints_fetch_sv||5.013007| |
|
3758 +cop_store_label||5.015001| |
|
3759 +cophh_2hv||5.013007| |
|
3760 +cophh_copy||5.013007| |
|
3761 +cophh_delete_pvn||5.013007| |
|
3762 +cophh_delete_pvs||5.013007| |
|
3763 +cophh_delete_pv||5.013007| |
|
3764 +cophh_delete_sv||5.013007| |
|
3765 +cophh_fetch_pvn||5.013007| |
|
3766 +cophh_fetch_pvs||5.013007| |
|
3767 +cophh_fetch_pv||5.013007| |
|
3768 +cophh_fetch_sv||5.013007| |
|
3769 +cophh_free||5.013007| |
|
3770 +cophh_new_empty||5.019003| |
|
3771 +cophh_store_pvn||5.013007| |
|
3772 +cophh_store_pvs||5.013007| |
|
3773 +cophh_store_pv||5.013007| |
|
3774 +cophh_store_sv||5.013007| |
|
3775 +core_prototype||| |
|
3776 +core_regclass_swash||| |
|
3777 +coresub_op||| |
|
3778 +could_it_be_a_POSIX_class||| |
|
3779 +cr_textfilter||| |
|
3780 +create_eval_scope||| |
|
3781 +croak_memory_wrap||5.019003|n |
|
3782 +croak_no_mem|||n |
|
3783 +croak_no_modify||5.013003|n |
|
3784 +croak_nocontext|||vn |
|
3785 +croak_popstack|||n |
|
3786 +croak_sv||5.013001| |
|
3787 +croak_xs_usage||5.010001|n |
|
3788 +croak|||v |
|
3789 +csighandler||5.009003|n |
|
3790 +curmad||| |
|
3791 +current_re_engine||| |
|
3792 +curse||| |
|
3793 +custom_op_desc||5.007003| |
|
3794 +custom_op_name||5.007003| |
|
3795 +custom_op_register||5.013007| |
|
3796 +custom_op_xop||5.013007| |
|
3797 +cv_ckproto_len_flags||| |
|
3798 +cv_clone_into||| |
|
3799 +cv_clone||| |
|
3800 +cv_const_sv_or_av||| |
|
3801 +cv_const_sv||5.004000| |
|
3802 +cv_dump||| |
|
3803 +cv_forget_slab||| |
|
3804 +cv_get_call_checker||5.013006| |
|
3805 +cv_set_call_checker||5.013006| |
|
3806 +cv_undef||| |
|
3807 +cvgv_set||| |
|
3808 +cvstash_set||| |
|
3809 +cx_dump||5.005000| |
|
3810 +cx_dup||| |
|
3811 +cxinc||| |
|
3812 +dAXMARK|5.009003||p |
|
3813 +dAX|5.007002||p |
|
3814 +dITEMS|5.007002||p |
|
3815 +dMARK||| |
|
3816 +dMULTICALL||5.009003| |
|
3817 +dMY_CXT_SV|5.007003||p |
|
3818 +dMY_CXT|5.007003||p |
|
3819 +dNOOP|5.006000||p |
|
3820 +dORIGMARK||| |
|
3821 +dSP||| |
|
3822 +dTHR|5.004050||p |
|
3823 +dTHXR|5.019002||p |
|
3824 +dTHXa|5.006000||p |
|
3825 +dTHXoa|5.006000||p |
|
3826 +dTHX|5.006000||p |
|
3827 +dUNDERBAR|5.009002||p |
|
3828 +dVAR|5.009003||p |
|
3829 +dXCPT|5.009002||p |
|
3830 +dXSARGS||| |
|
3831 +dXSI32||| |
|
3832 +dXSTARG|5.006000||p |
|
3833 +deb_curcv||| |
|
3834 +deb_nocontext|||vn |
|
3835 +deb_stack_all||| |
|
3836 +deb_stack_n||| |
|
3837 +debop||5.005000| |
|
3838 +debprofdump||5.005000| |
|
3839 +debprof||| |
|
3840 +debstackptrs||5.007003| |
|
3841 +debstack||5.007003| |
|
3842 +debug_start_match||| |
|
3843 +deb||5.007003|v |
|
3844 +defelem_target||| |
|
3845 +del_sv||| |
|
3846 +delete_eval_scope||| |
|
3847 +delimcpy||5.004000|n |
|
3848 +deprecate_commaless_var_list||| |
|
3849 +despatch_signals||5.007001| |
|
3850 +destroy_matcher||| |
|
3851 +die_nocontext|||vn |
|
3852 +die_sv||5.013001| |
|
3853 +die_unwind||| |
|
3854 +die|||v |
|
3855 +dirp_dup||| |
|
3856 +div128||| |
|
3857 +djSP||| |
|
3858 +do_aexec5||| |
|
3859 +do_aexec||| |
|
3860 +do_aspawn||| |
|
3861 +do_binmode||5.004050| |
|
3862 +do_chomp||| |
|
3863 +do_close||| |
|
3864 +do_delete_local||| |
|
3865 +do_dump_pad||| |
|
3866 +do_eof||| |
|
3867 +do_exec3||| |
|
3868 +do_execfree||| |
|
3869 +do_exec||| |
|
3870 +do_gv_dump||5.006000| |
|
3871 +do_gvgv_dump||5.006000| |
|
3872 +do_hv_dump||5.006000| |
|
3873 +do_ipcctl||| |
|
3874 +do_ipcget||| |
|
3875 +do_join||| |
|
3876 +do_magic_dump||5.006000| |
|
3877 +do_msgrcv||| |
|
3878 +do_msgsnd||| |
|
3879 +do_ncmp||| |
|
3880 +do_oddball||| |
|
3881 +do_op_dump||5.006000| |
|
3882 +do_op_xmldump||| |
|
3883 +do_open9||5.006000| |
|
3884 +do_openn||5.007001| |
|
3885 +do_open||5.004000| |
|
3886 +do_pmop_dump||5.006000| |
|
3887 +do_pmop_xmldump||| |
|
3888 +do_print||| |
|
3889 +do_readline||| |
|
3890 +do_seek||| |
|
3891 +do_semop||| |
|
3892 +do_shmio||| |
|
3893 +do_smartmatch||| |
|
3894 +do_spawn_nowait||| |
|
3895 +do_spawn||| |
|
3896 +do_sprintf||| |
|
3897 +do_sv_dump||5.006000| |
|
3898 +do_sysseek||| |
|
3899 +do_tell||| |
|
3900 +do_trans_complex_utf8||| |
|
3901 +do_trans_complex||| |
|
3902 +do_trans_count_utf8||| |
|
3903 +do_trans_count||| |
|
3904 +do_trans_simple_utf8||| |
|
3905 +do_trans_simple||| |
|
3906 +do_trans||| |
|
3907 +do_vecget||| |
|
3908 +do_vecset||| |
|
3909 +do_vop||| |
|
3910 +docatch||| |
|
3911 +doeval||| |
|
3912 +dofile||| |
|
3913 +dofindlabel||| |
|
3914 +doform||| |
|
3915 +doing_taint||5.008001|n |
|
3916 +dooneliner||| |
|
3917 +doopen_pm||| |
|
3918 +doparseform||| |
|
3919 +dopoptoeval||| |
|
3920 +dopoptogiven||| |
|
3921 +dopoptolabel||| |
|
3922 +dopoptoloop||| |
|
3923 +dopoptosub_at||| |
|
3924 +dopoptowhen||| |
|
3925 +doref||5.009003| |
|
3926 +dounwind||| |
|
3927 +dowantarray||| |
|
3928 +dump_all_perl||| |
|
3929 +dump_all||5.006000| |
|
3930 +dump_eval||5.006000| |
|
3931 +dump_exec_pos||| |
|
3932 +dump_fds||| |
|
3933 +dump_form||5.006000| |
|
3934 +dump_indent||5.006000|v |
|
3935 +dump_mstats||| |
|
3936 +dump_packsubs_perl||| |
|
3937 +dump_packsubs||5.006000| |
|
3938 +dump_sub_perl||| |
|
3939 +dump_sub||5.006000| |
|
3940 +dump_sv_child||| |
|
3941 +dump_trie_interim_list||| |
|
3942 +dump_trie_interim_table||| |
|
3943 +dump_trie||| |
|
3944 +dump_vindent||5.006000| |
|
3945 +dumpuntil||| |
|
3946 +dup_attrlist||| |
|
3947 +emulate_cop_io||| |
|
3948 +eval_pv|5.006000||p |
|
3949 +eval_sv|5.006000||p |
|
3950 +exec_failed||| |
|
3951 +expect_number||| |
|
3952 +fbm_compile||5.005000| |
|
3953 +fbm_instr||5.005000| |
|
3954 +feature_is_enabled||| |
|
3955 +filter_add||| |
|
3956 +filter_del||| |
|
3957 +filter_gets||| |
|
3958 +filter_read||| |
|
3959 +finalize_optree||| |
|
3960 +finalize_op||| |
|
3961 +find_and_forget_pmops||| |
|
3962 +find_array_subscript||| |
|
3963 +find_beginning||| |
|
3964 +find_byclass||| |
|
3965 +find_hash_subscript||| |
|
3966 +find_in_my_stash||| |
|
3967 +find_lexical_cv||| |
|
3968 +find_runcv_where||| |
|
3969 +find_runcv||5.008001| |
|
3970 +find_rundefsv2||| |
|
3971 +find_rundefsvoffset||5.009002| |
|
3972 +find_rundefsv||5.013002| |
|
3973 +find_script||| |
|
3974 +find_uninit_var||| |
|
3975 +first_symbol|||n |
|
3976 +foldEQ_latin1||5.013008|n |
|
3977 +foldEQ_locale||5.013002|n |
|
3978 +foldEQ_utf8_flags||5.013010| |
|
3979 +foldEQ_utf8||5.013002| |
|
3980 +foldEQ||5.013002|n |
|
3981 +fold_constants||| |
|
3982 +forbid_setid||| |
|
3983 +force_ident_maybe_lex||| |
|
3984 +force_ident||| |
|
3985 +force_list||| |
|
3986 +force_next||| |
|
3987 +force_strict_version||| |
|
3988 +force_version||| |
|
3989 +force_word||| |
|
3990 +forget_pmop||| |
|
3991 +form_nocontext|||vn |
|
3992 +form_short_octal_warning||| |
|
3993 +form||5.004000|v |
|
3994 +fp_dup||| |
|
3995 +fprintf_nocontext|||vn |
|
3996 +free_global_struct||| |
|
3997 +free_tied_hv_pool||| |
|
3998 +free_tmps||| |
|
3999 +gen_constant_list||| |
|
4000 +get_and_check_backslash_N_name||| |
|
4001 +get_aux_mg||| |
|
4002 +get_av|5.006000||p |
|
4003 +get_context||5.006000|n |
|
4004 +get_cvn_flags|5.009005||p |
|
4005 +get_cvs|5.011000||p |
|
4006 +get_cv|5.006000||p |
|
4007 +get_db_sub||| |
|
4008 +get_debug_opts||| |
|
4009 +get_hash_seed||| |
|
4010 +get_hv|5.006000||p |
|
4011 +get_invlist_iter_addr||| |
|
4012 +get_invlist_offset_addr||| |
|
4013 +get_invlist_previous_index_addr||| |
|
4014 +get_mstats||| |
|
4015 +get_no_modify||| |
|
4016 +get_num||| |
|
4017 +get_op_descs||5.005000| |
|
4018 +get_op_names||5.005000| |
|
4019 +get_opargs||| |
|
4020 +get_ppaddr||5.006000| |
|
4021 +get_re_arg||| |
|
4022 +get_sv|5.006000||p |
|
4023 +get_vtbl||5.005030| |
|
4024 +getcwd_sv||5.007002| |
|
4025 +getenv_len||| |
|
4026 +glob_2number||| |
|
4027 +glob_assign_glob||| |
|
4028 +glob_assign_ref||| |
|
4029 +gp_dup||| |
|
4030 +gp_free||| |
|
4031 +gp_ref||| |
|
4032 +grok_bin|5.007003||p |
|
4033 +grok_bslash_N||| |
|
4034 +grok_bslash_c||| |
|
4035 +grok_bslash_o||| |
|
4036 +grok_bslash_x||| |
|
4037 +grok_hex|5.007003||p |
|
4038 +grok_number|5.007002||p |
|
4039 +grok_numeric_radix|5.007002||p |
|
4040 +grok_oct|5.007003||p |
|
4041 +group_end||| |
|
4042 +gv_AVadd||| |
|
4043 +gv_HVadd||| |
|
4044 +gv_IOadd||| |
|
4045 +gv_SVadd||| |
|
4046 +gv_add_by_type||5.011000| |
|
4047 +gv_autoload4||5.004000| |
|
4048 +gv_autoload_pvn||5.015004| |
|
4049 +gv_autoload_pv||5.015004| |
|
4050 +gv_autoload_sv||5.015004| |
|
4051 +gv_check||| |
|
4052 +gv_const_sv||5.009003| |
|
4053 +gv_dump||5.006000| |
|
4054 +gv_efullname3||5.004000| |
|
4055 +gv_efullname4||5.006001| |
|
4056 +gv_efullname||| |
|
4057 +gv_ename||| |
|
4058 +gv_fetchfile_flags||5.009005| |
|
4059 +gv_fetchfile||| |
|
4060 +gv_fetchmeth_autoload||5.007003| |
|
4061 +gv_fetchmeth_pv_autoload||5.015004| |
|
4062 +gv_fetchmeth_pvn_autoload||5.015004| |
|
4063 +gv_fetchmeth_pvn||5.015004| |
|
4064 +gv_fetchmeth_pv||5.015004| |
|
4065 +gv_fetchmeth_sv_autoload||5.015004| |
|
4066 +gv_fetchmeth_sv||5.015004| |
|
4067 +gv_fetchmethod_autoload||5.004000| |
|
4068 +gv_fetchmethod_pv_flags||5.015004| |
|
4069 +gv_fetchmethod_pvn_flags||5.015004| |
|
4070 +gv_fetchmethod_sv_flags||5.015004| |
|
4071 +gv_fetchmethod||| |
|
4072 +gv_fetchmeth||| |
|
4073 +gv_fetchpvn_flags|5.009002||p |
|
4074 +gv_fetchpvs|5.009004||p |
|
4075 +gv_fetchpv||| |
|
4076 +gv_fetchsv|5.009002||p |
|
4077 +gv_fullname3||5.004000| |
|
4078 +gv_fullname4||5.006001| |
|
4079 +gv_fullname||| |
|
4080 +gv_handler||5.007001| |
|
4081 +gv_init_pvn||5.015004| |
|
4082 +gv_init_pv||5.015004| |
|
4083 +gv_init_svtype||| |
|
4084 +gv_init_sv||5.015004| |
|
4085 +gv_init||| |
|
4086 +gv_magicalize_isa||| |
|
4087 +gv_name_set||5.009004| |
|
4088 +gv_stashpvn|5.004000||p |
|
4089 +gv_stashpvs|5.009003||p |
|
4090 +gv_stashpv||| |
|
4091 +gv_stashsv||| |
|
4092 +gv_try_downgrade||| |
|
4093 +handle_regex_sets||| |
|
4094 +he_dup||| |
|
4095 +hek_dup||| |
|
4096 +hfree_next_entry||| |
|
4097 +hfreeentries||| |
|
4098 +hsplit||| |
|
4099 +hv_assert||| |
|
4100 +hv_auxinit||| |
|
4101 +hv_backreferences_p||| |
|
4102 +hv_clear_placeholders||5.009001| |
|
4103 +hv_clear||| |
|
4104 +hv_common_key_len||5.010000| |
|
4105 +hv_common||5.010000| |
|
4106 +hv_copy_hints_hv||5.009004| |
|
4107 +hv_delayfree_ent||5.004000| |
|
4108 +hv_delete_common||| |
|
4109 +hv_delete_ent||5.004000| |
|
4110 +hv_delete||| |
|
4111 +hv_eiter_p||5.009003| |
|
4112 +hv_eiter_set||5.009003| |
|
4113 +hv_ename_add||| |
|
4114 +hv_ename_delete||| |
|
4115 +hv_exists_ent||5.004000| |
|
4116 +hv_exists||| |
|
4117 +hv_fetch_ent||5.004000| |
|
4118 +hv_fetchs|5.009003||p |
|
4119 +hv_fetch||| |
|
4120 +hv_fill||5.013002| |
|
4121 +hv_free_ent_ret||| |
|
4122 +hv_free_ent||5.004000| |
|
4123 +hv_iterinit||| |
|
4124 +hv_iterkeysv||5.004000| |
|
4125 +hv_iterkey||| |
|
4126 +hv_iternext_flags||5.008000| |
|
4127 +hv_iternextsv||| |
|
4128 +hv_iternext||| |
|
4129 +hv_iterval||| |
|
4130 +hv_kill_backrefs||| |
|
4131 +hv_ksplit||5.004000| |
|
4132 +hv_magic_check|||n |
|
4133 +hv_magic||| |
|
4134 +hv_name_set||5.009003| |
|
4135 +hv_notallowed||| |
|
4136 +hv_placeholders_get||5.009003| |
|
4137 +hv_placeholders_p||| |
|
4138 +hv_placeholders_set||5.009003| |
|
4139 +hv_rand_set||5.017011| |
|
4140 +hv_riter_p||5.009003| |
|
4141 +hv_riter_set||5.009003| |
|
4142 +hv_scalar||5.009001| |
|
4143 +hv_store_ent||5.004000| |
|
4144 +hv_store_flags||5.008000| |
|
4145 +hv_stores|5.009004||p |
|
4146 +hv_store||| |
|
4147 +hv_undef_flags||| |
|
4148 +hv_undef||| |
|
4149 +ibcmp_locale||5.004000| |
|
4150 +ibcmp_utf8||5.007003| |
|
4151 +ibcmp||| |
|
4152 +incline||| |
|
4153 +incpush_if_exists||| |
|
4154 +incpush_use_sep||| |
|
4155 +incpush||| |
|
4156 +ingroup||| |
|
4157 +init_argv_symbols||| |
|
4158 +init_constants||| |
|
4159 +init_dbargs||| |
|
4160 +init_debugger||| |
|
4161 +init_global_struct||| |
|
4162 +init_i18nl10n||5.006000| |
|
4163 +init_i18nl14n||5.006000| |
|
4164 +init_ids||| |
|
4165 +init_interp||| |
|
4166 +init_main_stash||| |
|
4167 +init_perllib||| |
|
4168 +init_postdump_symbols||| |
|
4169 +init_predump_symbols||| |
|
4170 +init_stacks||5.005000| |
|
4171 +init_tm||5.007002| |
|
4172 +inplace_aassign||| |
|
4173 +instr|||n |
|
4174 +intro_my||| |
|
4175 +intuit_method||| |
|
4176 +intuit_more||| |
|
4177 +invert||| |
|
4178 +invlist_array||| |
|
4179 +invlist_clone||| |
|
4180 +invlist_extend||| |
|
4181 +invlist_highest||| |
|
4182 +invlist_is_iterating||| |
|
4183 +invlist_iterfinish||| |
|
4184 +invlist_iterinit||| |
|
4185 +invlist_iternext||| |
|
4186 +invlist_max||| |
|
4187 +invlist_previous_index||| |
|
4188 +invlist_set_len||| |
|
4189 +invlist_set_previous_index||| |
|
4190 +invlist_trim||| |
|
4191 +invoke_exception_hook||| |
|
4192 +io_close||| |
|
4193 +isALNUMC|5.006000||p |
|
4194 +isALNUM_lazy||| |
|
4195 +isALPHANUMERIC||5.017008| |
|
4196 +isALPHA||| |
|
4197 +isASCII|5.006000|5.006000|p |
|
4198 +isBLANK|5.006001||p |
|
4199 +isCNTRL|5.006000|5.006000|p |
|
4200 +isDIGIT||| |
|
4201 +isFOO_lc||| |
|
4202 +isFOO_utf8_lc||| |
|
4203 +isGRAPH|5.006000||p |
|
4204 +isGV_with_GP|5.009004||p |
|
4205 +isIDCONT||5.017008| |
|
4206 +isIDFIRST_lazy||| |
|
4207 +isIDFIRST||| |
|
4208 +isLOWER||| |
|
4209 +isOCTAL||5.013005| |
|
4210 +isPRINT|5.004000||p |
|
4211 +isPSXSPC|5.006001||p |
|
4212 +isPUNCT|5.006000||p |
|
4213 +isSPACE||| |
|
4214 +isUPPER||| |
|
4215 +isWORDCHAR||5.013006| |
|
4216 +isXDIGIT|5.006000||p |
|
4217 +is_an_int||| |
|
4218 +is_ascii_string||5.011000|n |
|
4219 +is_cur_LC_category_utf8||| |
|
4220 +is_handle_constructor|||n |
|
4221 +is_list_assignment||| |
|
4222 +is_lvalue_sub||5.007001| |
|
4223 +is_uni_alnum_lc||5.006000| |
|
4224 +is_uni_alnumc_lc||5.017007| |
|
4225 +is_uni_alnumc||5.017007| |
|
4226 +is_uni_alnum||5.006000| |
|
4227 +is_uni_alpha_lc||5.006000| |
|
4228 +is_uni_alpha||5.006000| |
|
4229 +is_uni_ascii_lc||5.006000| |
|
4230 +is_uni_ascii||5.006000| |
|
4231 +is_uni_blank_lc||5.017002| |
|
4232 +is_uni_blank||5.017002| |
|
4233 +is_uni_cntrl_lc||5.006000| |
|
4234 +is_uni_cntrl||5.006000| |
|
4235 +is_uni_digit_lc||5.006000| |
|
4236 +is_uni_digit||5.006000| |
|
4237 +is_uni_graph_lc||5.006000| |
|
4238 +is_uni_graph||5.006000| |
|
4239 +is_uni_idfirst_lc||5.006000| |
|
4240 +is_uni_idfirst||5.006000| |
|
4241 +is_uni_lower_lc||5.006000| |
|
4242 +is_uni_lower||5.006000| |
|
4243 +is_uni_print_lc||5.006000| |
|
4244 +is_uni_print||5.006000| |
|
4245 +is_uni_punct_lc||5.006000| |
|
4246 +is_uni_punct||5.006000| |
|
4247 +is_uni_space_lc||5.006000| |
|
4248 +is_uni_space||5.006000| |
|
4249 +is_uni_upper_lc||5.006000| |
|
4250 +is_uni_upper||5.006000| |
|
4251 +is_uni_xdigit_lc||5.006000| |
|
4252 +is_uni_xdigit||5.006000| |
|
4253 +is_utf8_alnumc||5.017007| |
|
4254 +is_utf8_alnum||5.006000| |
|
4255 +is_utf8_alpha||5.006000| |
|
4256 +is_utf8_ascii||5.006000| |
|
4257 +is_utf8_blank||5.017002| |
|
4258 +is_utf8_char_buf||5.015008|n |
|
4259 +is_utf8_char_slow|||n |
|
4260 +is_utf8_char||5.006000|n |
|
4261 +is_utf8_cntrl||5.006000| |
|
4262 +is_utf8_common||| |
|
4263 +is_utf8_digit||5.006000| |
|
4264 +is_utf8_graph||5.006000| |
|
4265 +is_utf8_idcont||5.008000| |
|
4266 +is_utf8_idfirst||5.006000| |
|
4267 +is_utf8_lower||5.006000| |
|
4268 +is_utf8_mark||5.006000| |
|
4269 +is_utf8_perl_space||5.011001| |
|
4270 +is_utf8_perl_word||5.011001| |
|
4271 +is_utf8_posix_digit||5.011001| |
|
4272 +is_utf8_print||5.006000| |
|
4273 +is_utf8_punct||5.006000| |
|
4274 +is_utf8_space||5.006000| |
|
4275 +is_utf8_string_loclen||5.009003|n |
|
4276 +is_utf8_string_loc||5.008001|n |
|
4277 +is_utf8_string||5.006001|n |
|
4278 +is_utf8_upper||5.006000| |
|
4279 +is_utf8_xdigit||5.006000| |
|
4280 +is_utf8_xidcont||5.013010| |
|
4281 +is_utf8_xidfirst||5.013010| |
|
4282 +isa_lookup||| |
|
4283 +items|||n |
|
4284 +ix|||n |
|
4285 +jmaybe||| |
|
4286 +join_exact||| |
|
4287 +keyword_plugin_standard||| |
|
4288 +keyword||| |
|
4289 +leave_scope||| |
|
4290 +lex_bufutf8||5.011002| |
|
4291 +lex_discard_to||5.011002| |
|
4292 +lex_grow_linestr||5.011002| |
|
4293 +lex_next_chunk||5.011002| |
|
4294 +lex_peek_unichar||5.011002| |
|
4295 +lex_read_space||5.011002| |
|
4296 +lex_read_to||5.011002| |
|
4297 +lex_read_unichar||5.011002| |
|
4298 +lex_start||5.009005| |
|
4299 +lex_stuff_pvn||5.011002| |
|
4300 +lex_stuff_pvs||5.013005| |
|
4301 +lex_stuff_pv||5.013006| |
|
4302 +lex_stuff_sv||5.011002| |
|
4303 +lex_unstuff||5.011002| |
|
4304 +listkids||| |
|
4305 +list||| |
|
4306 +load_module_nocontext|||vn |
|
4307 +load_module|5.006000||pv |
|
4308 +localize||| |
|
4309 +looks_like_bool||| |
|
4310 +looks_like_number||| |
|
4311 +lop||| |
|
4312 +mPUSHi|5.009002||p |
|
4313 +mPUSHn|5.009002||p |
|
4314 +mPUSHp|5.009002||p |
|
4315 +mPUSHs|5.010001||p |
|
4316 +mPUSHu|5.009002||p |
|
4317 +mXPUSHi|5.009002||p |
|
4318 +mXPUSHn|5.009002||p |
|
4319 +mXPUSHp|5.009002||p |
|
4320 +mXPUSHs|5.010001||p |
|
4321 +mXPUSHu|5.009002||p |
|
4322 +mad_free||| |
|
4323 +madlex||| |
|
4324 +madparse||| |
|
4325 +magic_clear_all_env||| |
|
4326 +magic_cleararylen_p||| |
|
4327 +magic_clearenv||| |
|
4328 +magic_clearhints||| |
|
4329 +magic_clearhint||| |
|
4330 +magic_clearisa||| |
|
4331 +magic_clearpack||| |
|
4332 +magic_clearsig||| |
|
4333 +magic_copycallchecker||| |
|
4334 +magic_dump||5.006000| |
|
4335 +magic_existspack||| |
|
4336 +magic_freearylen_p||| |
|
4337 +magic_freeovrld||| |
|
4338 +magic_getarylen||| |
|
4339 +magic_getdefelem||| |
|
4340 +magic_getnkeys||| |
|
4341 +magic_getpack||| |
|
4342 +magic_getpos||| |
|
4343 +magic_getsig||| |
|
4344 +magic_getsubstr||| |
|
4345 +magic_gettaint||| |
|
4346 +magic_getuvar||| |
|
4347 +magic_getvec||| |
|
4348 +magic_get||| |
|
4349 +magic_killbackrefs||| |
|
4350 +magic_methcall1||| |
|
4351 +magic_methcall|||v |
|
4352 +magic_methpack||| |
|
4353 +magic_nextpack||| |
|
4354 +magic_regdata_cnt||| |
|
4355 +magic_regdatum_get||| |
|
4356 +magic_regdatum_set||| |
|
4357 +magic_scalarpack||| |
|
4358 +magic_set_all_env||| |
|
4359 +magic_setarylen||| |
|
4360 +magic_setcollxfrm||| |
|
4361 +magic_setdbline||| |
|
4362 +magic_setdefelem||| |
|
4363 +magic_setenv||| |
|
4364 +magic_sethint||| |
|
4365 +magic_setisa||| |
|
4366 +magic_setmglob||| |
|
4367 +magic_setnkeys||| |
|
4368 +magic_setpack||| |
|
4369 +magic_setpos||| |
|
4370 +magic_setregexp||| |
|
4371 +magic_setsig||| |
|
4372 +magic_setsubstr||| |
|
4373 +magic_settaint||| |
|
4374 +magic_setutf8||| |
|
4375 +magic_setuvar||| |
|
4376 +magic_setvec||| |
|
4377 +magic_set||| |
|
4378 +magic_sizepack||| |
|
4379 +magic_wipepack||| |
|
4380 +make_matcher||| |
|
4381 +make_trie_failtable||| |
|
4382 +make_trie||| |
|
4383 +malloc_good_size|||n |
|
4384 +malloced_size|||n |
|
4385 +malloc||5.007002|n |
|
4386 +markstack_grow||| |
|
4387 +matcher_matches_sv||| |
|
4388 +mayberelocate||| |
|
4389 +measure_struct||| |
|
4390 +memEQs|5.009005||p |
|
4391 +memEQ|5.004000||p |
|
4392 +memNEs|5.009005||p |
|
4393 +memNE|5.004000||p |
|
4394 +mem_collxfrm||| |
|
4395 +mem_log_common|||n |
|
4396 +mess_alloc||| |
|
4397 +mess_nocontext|||vn |
|
4398 +mess_sv||5.013001| |
|
4399 +mess||5.006000|v |
|
4400 +method_common||| |
|
4401 +mfree||5.007002|n |
|
4402 +mg_clear||| |
|
4403 +mg_copy||| |
|
4404 +mg_dup||| |
|
4405 +mg_find_mglob||| |
|
4406 +mg_findext||5.013008| |
|
4407 +mg_find||| |
|
4408 +mg_free_type||5.013006| |
|
4409 +mg_free||| |
|
4410 +mg_get||| |
|
4411 +mg_length||5.005000| |
|
4412 +mg_localize||| |
|
4413 +mg_magical||| |
|
4414 +mg_set||| |
|
4415 +mg_size||5.005000| |
|
4416 +mini_mktime||5.007002| |
|
4417 +minus_v||| |
|
4418 +missingterm||| |
|
4419 +mode_from_discipline||| |
|
4420 +modkids||| |
|
4421 +more_bodies||| |
|
4422 +more_sv||| |
|
4423 +moreswitches||| |
|
4424 +mro_clean_isarev||| |
|
4425 +mro_gather_and_rename||| |
|
4426 +mro_get_from_name||5.010001| |
|
4427 +mro_get_linear_isa_dfs||| |
|
4428 +mro_get_linear_isa||5.009005| |
|
4429 +mro_get_private_data||5.010001| |
|
4430 +mro_isa_changed_in||| |
|
4431 +mro_meta_dup||| |
|
4432 +mro_meta_init||| |
|
4433 +mro_method_changed_in||5.009005| |
|
4434 +mro_package_moved||| |
|
4435 +mro_register||5.010001| |
|
4436 +mro_set_mro||5.010001| |
|
4437 +mro_set_private_data||5.010001| |
|
4438 +mul128||| |
|
4439 +mulexp10|||n |
|
4440 +my_atof2||5.007002| |
|
4441 +my_atof||5.006000| |
|
4442 +my_attrs||| |
|
4443 +my_bcopy|||n |
|
4444 +my_bzero|||n |
|
4445 +my_chsize||| |
|
4446 +my_clearenv||| |
|
4447 +my_cxt_index||| |
|
4448 +my_cxt_init||| |
|
4449 +my_dirfd||5.009005| |
|
4450 +my_exit_jump||| |
|
4451 +my_exit||| |
|
4452 +my_failure_exit||5.004000| |
|
4453 +my_fflush_all||5.006000| |
|
4454 +my_fork||5.007003|n |
|
4455 +my_kid||| |
|
4456 +my_lstat_flags||| |
|
4457 +my_lstat||5.019003| |
|
4458 +my_memcmp|||n |
|
4459 +my_memset||5.004000|n |
|
4460 +my_pclose||5.004000| |
|
4461 +my_popen_list||5.007001| |
|
4462 +my_popen||5.004000| |
|
4463 +my_setenv||| |
|
4464 +my_snprintf|5.009004||pvn |
|
4465 +my_socketpair||5.007003|n |
|
4466 +my_sprintf|5.009003||pvn |
|
4467 +my_stat_flags||| |
|
4468 +my_stat||5.019003| |
|
4469 +my_strftime||5.007002| |
|
4470 +my_strlcat|5.009004||pn |
|
4471 +my_strlcpy|5.009004||pn |
|
4472 +my_unexec||| |
|
4473 +my_vsnprintf||5.009004|n |
|
4474 +need_utf8|||n |
|
4475 +newANONATTRSUB||5.006000| |
|
4476 +newANONHASH||| |
|
4477 +newANONLIST||| |
|
4478 +newANONSUB||| |
|
4479 +newASSIGNOP||| |
|
4480 +newATTRSUB_flags||| |
|
4481 +newATTRSUB||5.006000| |
|
4482 +newAVREF||| |
|
4483 +newAV||| |
|
4484 +newBINOP||| |
|
4485 +newCONDOP||| |
|
4486 +newCONSTSUB_flags||5.015006| |
|
4487 +newCONSTSUB|5.004050||p |
|
4488 +newCVREF||| |
|
4489 +newDEFSVOP||| |
|
4490 +newFORM||| |
|
4491 +newFOROP||5.013007| |
|
4492 +newGIVENOP||5.009003| |
|
4493 +newGIVWHENOP||| |
|
4494 +newGP||| |
|
4495 +newGVOP||| |
|
4496 +newGVREF||| |
|
4497 +newGVgen_flags||5.015004| |
|
4498 +newGVgen||| |
|
4499 +newHVREF||| |
|
4500 +newHVhv||5.005000| |
|
4501 +newHV||| |
|
4502 +newIO||| |
|
4503 +newLISTOP||| |
|
4504 +newLOGOP||| |
|
4505 +newLOOPEX||| |
|
4506 +newLOOPOP||| |
|
4507 +newMADPROP||| |
|
4508 +newMADsv||| |
|
4509 +newMYSUB||5.017004| |
|
4510 +newNULLLIST||| |
|
4511 +newOP||| |
|
4512 +newPADOP||| |
|
4513 +newPMOP||| |
|
4514 +newPROG||| |
|
4515 +newPVOP||| |
|
4516 +newRANGE||| |
|
4517 +newRV_inc|5.004000||p |
|
4518 +newRV_noinc|5.004000||p |
|
4519 +newRV||| |
|
4520 +newSLICEOP||| |
|
4521 +newSTATEOP||| |
|
4522 +newSTUB||| |
|
4523 +newSUB||| |
|
4524 +newSVOP||| |
|
4525 +newSVREF||| |
|
4526 +newSV_type|5.009005||p |
|
4527 +newSVhek||5.009003| |
|
4528 +newSViv||| |
|
4529 +newSVnv||| |
|
4530 +newSVpadname||5.017004| |
|
4531 +newSVpv_share||5.013006| |
|
4532 +newSVpvf_nocontext|||vn |
|
4533 +newSVpvf||5.004000|v |
|
4534 +newSVpvn_flags|5.010001||p |
|
4535 +newSVpvn_share|5.007001||p |
|
4536 +newSVpvn_utf8|5.010001||p |
|
4537 +newSVpvn|5.004050||p |
|
4538 +newSVpvs_flags|5.010001||p |
|
4539 +newSVpvs_share|5.009003||p |
|
4540 +newSVpvs|5.009003||p |
|
4541 +newSVpv||| |
|
4542 +newSVrv||| |
|
4543 +newSVsv||| |
|
4544 +newSVuv|5.006000||p |
|
4545 +newSV||| |
|
4546 +newTOKEN||| |
|
4547 +newUNOP||| |
|
4548 +newWHENOP||5.009003| |
|
4549 +newWHILEOP||5.013007| |
|
4550 +newXS_flags||5.009004| |
|
4551 +newXS_len_flags||| |
|
4552 +newXSproto||5.006000| |
|
4553 +newXS||5.006000| |
|
4554 +new_collate||5.006000| |
|
4555 +new_constant||| |
|
4556 +new_ctype||5.006000| |
|
4557 +new_he||| |
|
4558 +new_logop||| |
|
4559 +new_numeric||5.006000| |
|
4560 +new_stackinfo||5.005000| |
|
4561 +new_version||5.009000| |
|
4562 +new_warnings_bitfield||| |
|
4563 +next_symbol||| |
|
4564 +nextargv||| |
|
4565 +nextchar||| |
|
4566 +ninstr|||n |
|
4567 +no_bareword_allowed||| |
|
4568 +no_fh_allowed||| |
|
4569 +no_op||| |
|
4570 +not_a_number||| |
|
4571 +not_incrementable||| |
|
4572 +nothreadhook||5.008000| |
|
4573 +nuke_stacks||| |
|
4574 +num_overflow|||n |
|
4575 +oopsAV||| |
|
4576 +oopsHV||| |
|
4577 +op_append_elem||5.013006| |
|
4578 +op_append_list||5.013006| |
|
4579 +op_clear||| |
|
4580 +op_const_sv||| |
|
4581 +op_contextualize||5.013006| |
|
4582 +op_dump||5.006000| |
|
4583 +op_free||| |
|
4584 +op_getmad_weak||| |
|
4585 +op_getmad||| |
|
4586 +op_integerize||| |
|
4587 +op_linklist||5.013006| |
|
4588 +op_lvalue_flags||| |
|
4589 +op_lvalue||5.013007| |
|
4590 +op_null||5.007002| |
|
4591 +op_prepend_elem||5.013006| |
|
4592 +op_refcnt_dec||| |
|
4593 +op_refcnt_inc||| |
|
4594 +op_refcnt_lock||5.009002| |
|
4595 +op_refcnt_unlock||5.009002| |
|
4596 +op_scope||5.013007| |
|
4597 +op_std_init||| |
|
4598 +op_unscope||| |
|
4599 +op_xmldump||| |
|
4600 +open_script||| |
|
4601 +opslab_force_free||| |
|
4602 +opslab_free_nopad||| |
|
4603 +opslab_free||| |
|
4604 +pMY_CXT_|5.007003||p |
|
4605 +pMY_CXT|5.007003||p |
|
4606 +pTHX_|5.006000||p |
|
4607 +pTHX|5.006000||p |
|
4608 +packWARN|5.007003||p |
|
4609 +pack_cat||5.007003| |
|
4610 +pack_rec||| |
|
4611 +package_version||| |
|
4612 +package||| |
|
4613 +packlist||5.008001| |
|
4614 +pad_add_anon||5.008001| |
|
4615 +pad_add_name_pvn||5.015001| |
|
4616 +pad_add_name_pvs||5.015001| |
|
4617 +pad_add_name_pv||5.015001| |
|
4618 +pad_add_name_sv||5.015001| |
|
4619 +pad_alloc_name||| |
|
4620 +pad_alloc||| |
|
4621 +pad_block_start||| |
|
4622 +pad_check_dup||| |
|
4623 +pad_compname_type||5.009003| |
|
4624 +pad_findlex||| |
|
4625 +pad_findmy_pvn||5.015001| |
|
4626 +pad_findmy_pvs||5.015001| |
|
4627 +pad_findmy_pv||5.015001| |
|
4628 +pad_findmy_sv||5.015001| |
|
4629 +pad_fixup_inner_anons||| |
|
4630 +pad_free||| |
|
4631 +pad_leavemy||| |
|
4632 +pad_new||5.008001| |
|
4633 +pad_peg|||n |
|
4634 +pad_push||| |
|
4635 +pad_reset||| |
|
4636 +pad_setsv||| |
|
4637 +pad_sv||| |
|
4638 +pad_swipe||| |
|
4639 +pad_tidy||5.008001| |
|
4640 +padlist_dup||| |
|
4641 +padlist_store||| |
|
4642 +parse_arithexpr||5.013008| |
|
4643 +parse_barestmt||5.013007| |
|
4644 +parse_block||5.013007| |
|
4645 +parse_body||| |
|
4646 +parse_fullexpr||5.013008| |
|
4647 +parse_fullstmt||5.013005| |
|
4648 +parse_ident||| |
|
4649 +parse_label||5.013007| |
|
4650 +parse_listexpr||5.013008| |
|
4651 +parse_lparen_question_flags||| |
|
4652 +parse_stmtseq||5.013006| |
|
4653 +parse_termexpr||5.013008| |
|
4654 +parse_unicode_opts||| |
|
4655 +parser_dup||| |
|
4656 +parser_free_nexttoke_ops||| |
|
4657 +parser_free||| |
|
4658 +path_is_searchable|||n |
|
4659 +peep||| |
|
4660 +pending_ident||| |
|
4661 +perl_alloc_using|||n |
|
4662 +perl_alloc|||n |
|
4663 +perl_clone_using|||n |
|
4664 +perl_clone|||n |
|
4665 +perl_construct|||n |
|
4666 +perl_destruct||5.007003|n |
|
4667 +perl_free|||n |
|
4668 +perl_parse||5.006000|n |
|
4669 +perl_run|||n |
|
4670 +pidgone||| |
|
4671 +pm_description||| |
|
4672 +pmop_dump||5.006000| |
|
4673 +pmop_xmldump||| |
|
4674 +pmruntime||| |
|
4675 +pmtrans||| |
|
4676 +pop_scope||| |
|
4677 +populate_isa|||v |
|
4678 +pregcomp||5.009005| |
|
4679 +pregexec||| |
|
4680 +pregfree2||5.011000| |
|
4681 +pregfree||| |
|
4682 +prepend_madprops||| |
|
4683 +prescan_version||5.011004| |
|
4684 +printbuf||| |
|
4685 +printf_nocontext|||vn |
|
4686 +process_special_blocks||| |
|
4687 +ptr_hash|||n |
|
4688 +ptr_table_clear||5.009005| |
|
4689 +ptr_table_fetch||5.009005| |
|
4690 +ptr_table_find|||n |
|
4691 +ptr_table_free||5.009005| |
|
4692 +ptr_table_new||5.009005| |
|
4693 +ptr_table_split||5.009005| |
|
4694 +ptr_table_store||5.009005| |
|
4695 +push_scope||| |
|
4696 +put_byte||| |
|
4697 +put_latin1_charclass_innards||| |
|
4698 +pv_display|5.006000||p |
|
4699 +pv_escape|5.009004||p |
|
4700 +pv_pretty|5.009004||p |
|
4701 +pv_uni_display||5.007003| |
|
4702 +qerror||| |
|
4703 +qsortsvu||| |
|
4704 +re_compile||5.009005| |
|
4705 +re_croak2||| |
|
4706 +re_dup_guts||| |
|
4707 +re_intuit_start||5.019001| |
|
4708 +re_intuit_string||5.006000| |
|
4709 +re_op_compile||| |
|
4710 +readpipe_override||| |
|
4711 +realloc||5.007002|n |
|
4712 +reentrant_free||5.019003| |
|
4713 +reentrant_init||5.019003| |
|
4714 +reentrant_retry||5.019003|vn |
|
4715 +reentrant_size||5.019003| |
|
4716 +ref_array_or_hash||| |
|
4717 +refcounted_he_chain_2hv||| |
|
4718 +refcounted_he_fetch_pvn||| |
|
4719 +refcounted_he_fetch_pvs||| |
|
4720 +refcounted_he_fetch_pv||| |
|
4721 +refcounted_he_fetch_sv||| |
|
4722 +refcounted_he_free||| |
|
4723 +refcounted_he_inc||| |
|
4724 +refcounted_he_new_pvn||| |
|
4725 +refcounted_he_new_pvs||| |
|
4726 +refcounted_he_new_pv||| |
|
4727 +refcounted_he_new_sv||| |
|
4728 +refcounted_he_value||| |
|
4729 +refkids||| |
|
4730 +refto||| |
|
4731 +ref||5.019003| |
|
4732 +reg_check_named_buff_matched||| |
|
4733 +reg_named_buff_all||5.009005| |
|
4734 +reg_named_buff_exists||5.009005| |
|
4735 +reg_named_buff_fetch||5.009005| |
|
4736 +reg_named_buff_firstkey||5.009005| |
|
4737 +reg_named_buff_iter||| |
|
4738 +reg_named_buff_nextkey||5.009005| |
|
4739 +reg_named_buff_scalar||5.009005| |
|
4740 +reg_named_buff||| |
|
4741 +reg_node||| |
|
4742 +reg_numbered_buff_fetch||| |
|
4743 +reg_numbered_buff_length||| |
|
4744 +reg_numbered_buff_store||| |
|
4745 +reg_qr_package||| |
|
4746 +reg_recode||| |
|
4747 +reg_scan_name||| |
|
4748 +reg_skipcomment||| |
|
4749 +reg_temp_copy||| |
|
4750 +reganode||| |
|
4751 +regatom||| |
|
4752 +regbranch||| |
|
4753 +regclass_swash||5.009004| |
|
4754 +regclass||| |
|
4755 +regcppop||| |
|
4756 +regcppush||| |
|
4757 +regcurly||| |
|
4758 +regdump_extflags||| |
|
4759 +regdump_intflags||| |
|
4760 +regdump||5.005000| |
|
4761 +regdupe_internal||| |
|
4762 +regexec_flags||5.005000| |
|
4763 +regfree_internal||5.009005| |
|
4764 +reghop3|||n |
|
4765 +reghop4|||n |
|
4766 +reghopmaybe3|||n |
|
4767 +reginclass||| |
|
4768 +reginitcolors||5.006000| |
|
4769 +reginsert||| |
|
4770 +regmatch||| |
|
4771 +regnext||5.005000| |
|
4772 +regpatws|||n |
|
4773 +regpiece||| |
|
4774 +regpposixcc||| |
|
4775 +regprop||| |
|
4776 +regrepeat||| |
|
4777 +regtail_study||| |
|
4778 +regtail||| |
|
4779 +regtry||| |
|
4780 +reguni||| |
|
4781 +regwhite|||n |
|
4782 +reg||| |
|
4783 +repeatcpy|||n |
|
4784 +report_evil_fh||| |
|
4785 +report_redefined_cv||| |
|
4786 +report_uninit||| |
|
4787 +report_wrongway_fh||| |
|
4788 +require_pv||5.006000| |
|
4789 +require_tie_mod||| |
|
4790 +restore_magic||| |
|
4791 +rninstr|||n |
|
4792 +rpeep||| |
|
4793 +rsignal_restore||| |
|
4794 +rsignal_save||| |
|
4795 +rsignal_state||5.004000| |
|
4796 +rsignal||5.004000| |
|
4797 +run_body||| |
|
4798 +run_user_filter||| |
|
4799 +runops_debug||5.005000| |
|
4800 +runops_standard||5.005000| |
|
4801 +rv2cv_op_cv||5.013006| |
|
4802 +rvpv_dup||| |
|
4803 +rxres_free||| |
|
4804 +rxres_restore||| |
|
4805 +rxres_save||| |
|
4806 +safesyscalloc||5.006000|n |
|
4807 +safesysfree||5.006000|n |
|
4808 +safesysmalloc||5.006000|n |
|
4809 +safesysrealloc||5.006000|n |
|
4810 +same_dirent||| |
|
4811 +save_I16||5.004000| |
|
4812 +save_I32||| |
|
4813 +save_I8||5.006000| |
|
4814 +save_adelete||5.011000| |
|
4815 +save_aelem_flags||5.011000| |
|
4816 +save_aelem||5.004050| |
|
4817 +save_alloc||5.006000| |
|
4818 +save_aptr||| |
|
4819 +save_ary||| |
|
4820 +save_bool||5.008001| |
|
4821 +save_clearsv||| |
|
4822 +save_delete||| |
|
4823 +save_destructor_x||5.006000| |
|
4824 +save_destructor||5.006000| |
|
4825 +save_freeop||| |
|
4826 +save_freepv||| |
|
4827 +save_freesv||| |
|
4828 +save_generic_pvref||5.006001| |
|
4829 +save_generic_svref||5.005030| |
|
4830 +save_gp||5.004000| |
|
4831 +save_hash||| |
|
4832 +save_hdelete||5.011000| |
|
4833 +save_hek_flags|||n |
|
4834 +save_helem_flags||5.011000| |
|
4835 +save_helem||5.004050| |
|
4836 +save_hints||5.010001| |
|
4837 +save_hptr||| |
|
4838 +save_int||| |
|
4839 +save_item||| |
|
4840 +save_iv||5.005000| |
|
4841 +save_lines||| |
|
4842 +save_list||| |
|
4843 +save_long||| |
|
4844 +save_magic_flags||| |
|
4845 +save_mortalizesv||5.007001| |
|
4846 +save_nogv||| |
|
4847 +save_op||5.005000| |
|
4848 +save_padsv_and_mortalize||5.010001| |
|
4849 +save_pptr||| |
|
4850 +save_pushi32ptr||5.010001| |
|
4851 +save_pushptri32ptr||| |
|
4852 +save_pushptrptr||5.010001| |
|
4853 +save_pushptr||5.010001| |
|
4854 +save_re_context||5.006000| |
|
4855 +save_scalar_at||| |
|
4856 +save_scalar||| |
|
4857 +save_set_svflags||5.009000| |
|
4858 +save_shared_pvref||5.007003| |
|
4859 +save_sptr||| |
|
4860 +save_svref||| |
|
4861 +save_vptr||5.006000| |
|
4862 +savepvn||| |
|
4863 +savepvs||5.009003| |
|
4864 +savepv||| |
|
4865 +savesharedpvn||5.009005| |
|
4866 +savesharedpvs||5.013006| |
|
4867 +savesharedpv||5.007003| |
|
4868 +savesharedsvpv||5.013006| |
|
4869 +savestack_grow_cnt||5.008001| |
|
4870 +savestack_grow||| |
|
4871 +savesvpv||5.009002| |
|
4872 +sawparens||| |
|
4873 +scalar_mod_type|||n |
|
4874 +scalarboolean||| |
|
4875 +scalarkids||| |
|
4876 +scalarseq||| |
|
4877 +scalarvoid||| |
|
4878 +scalar||| |
|
4879 +scan_bin||5.006000| |
|
4880 +scan_commit||| |
|
4881 +scan_const||| |
|
4882 +scan_formline||| |
|
4883 +scan_heredoc||| |
|
4884 +scan_hex||| |
|
4885 +scan_ident||| |
|
4886 +scan_inputsymbol||| |
|
4887 +scan_num||5.007001| |
|
4888 +scan_oct||| |
|
4889 +scan_pat||| |
|
4890 +scan_str||| |
|
4891 +scan_subst||| |
|
4892 +scan_trans||| |
|
4893 +scan_version||5.009001| |
|
4894 +scan_vstring||5.009005| |
|
4895 +scan_word||| |
|
4896 +screaminstr||5.005000| |
|
4897 +search_const||| |
|
4898 +seed||5.008001| |
|
4899 +sequence_num||| |
|
4900 +set_context||5.006000|n |
|
4901 +set_numeric_local||5.006000| |
|
4902 +set_numeric_radix||5.006000| |
|
4903 +set_numeric_standard||5.006000| |
|
4904 +setdefout||| |
|
4905 +share_hek_flags||| |
|
4906 +share_hek||5.004000| |
|
4907 +si_dup||| |
|
4908 +sighandler|||n |
|
4909 +simplify_sort||| |
|
4910 +skipspace0||| |
|
4911 +skipspace1||| |
|
4912 +skipspace2||| |
|
4913 +skipspace_flags||| |
|
4914 +softref2xv||| |
|
4915 +sortcv_stacked||| |
|
4916 +sortcv_xsub||| |
|
4917 +sortcv||| |
|
4918 +sortsv_flags||5.009003| |
|
4919 +sortsv||5.007003| |
|
4920 +space_join_names_mortal||| |
|
4921 +ss_dup||| |
|
4922 +stack_grow||| |
|
4923 +start_force||| |
|
4924 +start_glob||| |
|
4925 +start_subparse||5.004000| |
|
4926 +stdize_locale||| |
|
4927 +strEQ||| |
|
4928 +strGE||| |
|
4929 +strGT||| |
|
4930 +strLE||| |
|
4931 +strLT||| |
|
4932 +strNE||| |
|
4933 +str_to_version||5.006000| |
|
4934 +strip_return||| |
|
4935 +strnEQ||| |
|
4936 +strnNE||| |
|
4937 +study_chunk||| |
|
4938 +sub_crush_depth||| |
|
4939 +sublex_done||| |
|
4940 +sublex_push||| |
|
4941 +sublex_start||| |
|
4942 +sv_2bool_flags||5.013006| |
|
4943 +sv_2bool||| |
|
4944 +sv_2cv||| |
|
4945 +sv_2io||| |
|
4946 +sv_2iuv_common||| |
|
4947 +sv_2iuv_non_preserve||| |
|
4948 +sv_2iv_flags||5.009001| |
|
4949 +sv_2iv||| |
|
4950 +sv_2mortal||| |
|
4951 +sv_2num||| |
|
4952 +sv_2nv_flags||5.013001| |
|
4953 +sv_2pv_flags|5.007002||p |
|
4954 +sv_2pv_nolen|5.006000||p |
|
4955 +sv_2pvbyte_nolen|5.006000||p |
|
4956 +sv_2pvbyte|5.006000||p |
|
4957 +sv_2pvutf8_nolen||5.006000| |
|
4958 +sv_2pvutf8||5.006000| |
|
4959 +sv_2pv||| |
|
4960 +sv_2uv_flags||5.009001| |
|
4961 +sv_2uv|5.004000||p |
|
4962 +sv_add_arena||| |
|
4963 +sv_add_backref||| |
|
4964 +sv_backoff||| |
|
4965 +sv_bless||| |
|
4966 +sv_cat_decode||5.008001| |
|
4967 +sv_catpv_flags||5.013006| |
|
4968 +sv_catpv_mg|5.004050||p |
|
4969 +sv_catpv_nomg||5.013006| |
|
4970 +sv_catpvf_mg_nocontext|||pvn |
|
4971 +sv_catpvf_mg|5.006000|5.004000|pv |
|
4972 +sv_catpvf_nocontext|||vn |
|
4973 +sv_catpvf||5.004000|v |
|
4974 +sv_catpvn_flags||5.007002| |
|
4975 +sv_catpvn_mg|5.004050||p |
|
4976 +sv_catpvn_nomg|5.007002||p |
|
4977 +sv_catpvn||| |
|
4978 +sv_catpvs_flags||5.013006| |
|
4979 +sv_catpvs_mg||5.013006| |
|
4980 +sv_catpvs_nomg||5.013006| |
|
4981 +sv_catpvs|5.009003||p |
|
4982 +sv_catpv||| |
|
4983 +sv_catsv_flags||5.007002| |
|
4984 +sv_catsv_mg|5.004050||p |
|
4985 +sv_catsv_nomg|5.007002||p |
|
4986 +sv_catsv||| |
|
4987 +sv_catxmlpvn||| |
|
4988 +sv_catxmlpv||| |
|
4989 +sv_catxmlsv||| |
|
4990 +sv_chop||| |
|
4991 +sv_clean_all||| |
|
4992 +sv_clean_objs||| |
|
4993 +sv_clear||| |
|
4994 +sv_cmp_flags||5.013006| |
|
4995 +sv_cmp_locale_flags||5.013006| |
|
4996 +sv_cmp_locale||5.004000| |
|
4997 +sv_cmp||| |
|
4998 +sv_collxfrm_flags||5.013006| |
|
4999 +sv_collxfrm||| |
|
5000 +sv_copypv_flags||5.017002| |
|
5001 +sv_copypv_nomg||5.017002| |
|
5002 +sv_copypv||| |
|
5003 +sv_dec_nomg||5.013002| |
|
5004 +sv_dec||| |
|
5005 +sv_del_backref||| |
|
5006 +sv_derived_from_pvn||5.015004| |
|
5007 +sv_derived_from_pv||5.015004| |
|
5008 +sv_derived_from_sv||5.015004| |
|
5009 +sv_derived_from||5.004000| |
|
5010 +sv_destroyable||5.010000| |
|
5011 +sv_display||| |
|
5012 +sv_does_pvn||5.015004| |
|
5013 +sv_does_pv||5.015004| |
|
5014 +sv_does_sv||5.015004| |
|
5015 +sv_does||5.009004| |
|
5016 +sv_dump||| |
|
5017 +sv_dup_common||| |
|
5018 +sv_dup_inc_multiple||| |
|
5019 +sv_dup_inc||| |
|
5020 +sv_dup||| |
|
5021 +sv_eq_flags||5.013006| |
|
5022 +sv_eq||| |
|
5023 +sv_exp_grow||| |
|
5024 +sv_force_normal_flags||5.007001| |
|
5025 +sv_force_normal||5.006000| |
|
5026 +sv_free2||| |
|
5027 +sv_free_arenas||| |
|
5028 +sv_free||| |
|
5029 +sv_gets||5.004000| |
|
5030 +sv_grow||| |
|
5031 +sv_i_ncmp||| |
|
5032 +sv_inc_nomg||5.013002| |
|
5033 +sv_inc||| |
|
5034 +sv_insert_flags||5.010001| |
|
5035 +sv_insert||| |
|
5036 +sv_isa||| |
|
5037 +sv_isobject||| |
|
5038 +sv_iv||5.005000| |
|
5039 +sv_kill_backrefs||| |
|
5040 +sv_len_utf8_nomg||| |
|
5041 +sv_len_utf8||5.006000| |
|
5042 +sv_len||| |
|
5043 +sv_magic_portable|5.019003|5.004000|p |
|
5044 +sv_magicext_mglob||| |
|
5045 +sv_magicext||5.007003| |
|
5046 +sv_magic||| |
|
5047 +sv_mortalcopy_flags||| |
|
5048 +sv_mortalcopy||| |
|
5049 +sv_ncmp||| |
|
5050 +sv_newmortal||| |
|
5051 +sv_newref||| |
|
5052 +sv_nolocking||5.007003| |
|
5053 +sv_nosharing||5.007003| |
|
5054 +sv_nounlocking||| |
|
5055 +sv_nv||5.005000| |
|
5056 +sv_peek||5.005000| |
|
5057 +sv_pos_b2u_flags||5.019003| |
|
5058 +sv_pos_b2u_midway||| |
|
5059 +sv_pos_b2u||5.006000| |
|
5060 +sv_pos_u2b_cached||| |
|
5061 +sv_pos_u2b_flags||5.011005| |
|
5062 +sv_pos_u2b_forwards|||n |
|
5063 +sv_pos_u2b_midway|||n |
|
5064 +sv_pos_u2b||5.006000| |
|
5065 +sv_pvbyten_force||5.006000| |
|
5066 +sv_pvbyten||5.006000| |
|
5067 +sv_pvbyte||5.006000| |
|
5068 +sv_pvn_force_flags|5.007002||p |
|
5069 +sv_pvn_force||| |
|
5070 +sv_pvn_nomg|5.007003|5.005000|p |
|
5071 +sv_pvn||5.005000| |
|
5072 +sv_pvutf8n_force||5.006000| |
|
5073 +sv_pvutf8n||5.006000| |
|
5074 +sv_pvutf8||5.006000| |
|
5075 +sv_pv||5.006000| |
|
5076 +sv_recode_to_utf8||5.007003| |
|
5077 +sv_reftype||| |
|
5078 +sv_ref||| |
|
5079 +sv_release_COW||| |
|
5080 +sv_replace||| |
|
5081 +sv_report_used||| |
|
5082 +sv_resetpvn||| |
|
5083 +sv_reset||| |
|
5084 +sv_rvweaken||5.006000| |
|
5085 +sv_sethek||| |
|
5086 +sv_setiv_mg|5.004050||p |
|
5087 +sv_setiv||| |
|
5088 +sv_setnv_mg|5.006000||p |
|
5089 +sv_setnv||| |
|
5090 +sv_setpv_mg|5.004050||p |
|
5091 +sv_setpvf_mg_nocontext|||pvn |
|
5092 +sv_setpvf_mg|5.006000|5.004000|pv |
|
5093 +sv_setpvf_nocontext|||vn |
|
5094 +sv_setpvf||5.004000|v |
|
5095 +sv_setpviv_mg||5.008001| |
|
5096 +sv_setpviv||5.008001| |
|
5097 +sv_setpvn_mg|5.004050||p |
|
5098 +sv_setpvn||| |
|
5099 +sv_setpvs_mg||5.013006| |
|
5100 +sv_setpvs|5.009004||p |
|
5101 +sv_setpv||| |
|
5102 +sv_setref_iv||| |
|
5103 +sv_setref_nv||| |
|
5104 +sv_setref_pvn||| |
|
5105 +sv_setref_pvs||5.019003| |
|
5106 +sv_setref_pv||| |
|
5107 +sv_setref_uv||5.007001| |
|
5108 +sv_setsv_cow||| |
|
5109 +sv_setsv_flags||5.007002| |
|
5110 +sv_setsv_mg|5.004050||p |
|
5111 +sv_setsv_nomg|5.007002||p |
|
5112 +sv_setsv||| |
|
5113 +sv_setuv_mg|5.004050||p |
|
5114 +sv_setuv|5.004000||p |
|
5115 +sv_tainted||5.004000| |
|
5116 +sv_taint||5.004000| |
|
5117 +sv_true||5.005000| |
|
5118 +sv_unglob||| |
|
5119 +sv_uni_display||5.007003| |
|
5120 +sv_unmagicext||5.013008| |
|
5121 +sv_unmagic||| |
|
5122 +sv_unref_flags||5.007001| |
|
5123 +sv_unref||| |
|
5124 +sv_untaint||5.004000| |
|
5125 +sv_upgrade||| |
|
5126 +sv_usepvn_flags||5.009004| |
|
5127 +sv_usepvn_mg|5.004050||p |
|
5128 +sv_usepvn||| |
|
5129 +sv_utf8_decode||5.006000| |
|
5130 +sv_utf8_downgrade||5.006000| |
|
5131 +sv_utf8_encode||5.006000| |
|
5132 +sv_utf8_upgrade_flags_grow||5.011000| |
|
5133 +sv_utf8_upgrade_flags||5.007002| |
|
5134 +sv_utf8_upgrade_nomg||5.007002| |
|
5135 +sv_utf8_upgrade||5.007001| |
|
5136 +sv_uv|5.005000||p |
|
5137 +sv_vcatpvf_mg|5.006000|5.004000|p |
|
5138 +sv_vcatpvfn_flags||5.017002| |
|
5139 +sv_vcatpvfn||5.004000| |
|
5140 +sv_vcatpvf|5.006000|5.004000|p |
|
5141 +sv_vsetpvf_mg|5.006000|5.004000|p |
|
5142 +sv_vsetpvfn||5.004000| |
|
5143 +sv_vsetpvf|5.006000|5.004000|p |
|
5144 +sv_xmlpeek||| |
|
5145 +svtype||| |
|
5146 +swallow_bom||| |
|
5147 +swash_fetch||5.007002| |
|
5148 +swash_init||5.006000| |
|
5149 +swatch_get||| |
|
5150 +sys_init3||5.010000|n |
|
5151 +sys_init||5.010000|n |
|
5152 +sys_intern_clear||| |
|
5153 +sys_intern_dup||| |
|
5154 +sys_intern_init||| |
|
5155 +sys_term||5.010000|n |
|
5156 +taint_env||| |
|
5157 +taint_proper||| |
|
5158 +tied_method|||v |
|
5159 +tmps_grow||5.006000| |
|
5160 +toFOLD_uni||5.007003| |
|
5161 +toFOLD_utf8||5.019001| |
|
5162 +toFOLD||5.019001| |
|
5163 +toLOWER_L1||5.019001| |
|
5164 +toLOWER_LC||5.004000| |
|
5165 +toLOWER_uni||5.007003| |
|
5166 +toLOWER_utf8||5.015007| |
|
5167 +toLOWER||| |
|
5168 +toTITLE_uni||5.007003| |
|
5169 +toTITLE_utf8||5.015007| |
|
5170 +toTITLE||5.019001| |
|
5171 +toUPPER_uni||5.007003| |
|
5172 +toUPPER_utf8||5.015007| |
|
5173 +toUPPER||5.004000| |
|
5174 +to_byte_substr||| |
|
5175 +to_lower_latin1||| |
|
5176 +to_uni_fold||5.007003| |
|
5177 +to_uni_lower_lc||5.006000| |
|
5178 +to_uni_lower||5.007003| |
|
5179 +to_uni_title_lc||5.006000| |
|
5180 +to_uni_title||5.007003| |
|
5181 +to_uni_upper_lc||5.006000| |
|
5182 +to_uni_upper||5.007003| |
|
5183 +to_utf8_case||5.007003| |
|
5184 +to_utf8_fold||5.015007| |
|
5185 +to_utf8_lower||5.015007| |
|
5186 +to_utf8_substr||| |
|
5187 +to_utf8_title||5.015007| |
|
5188 +to_utf8_upper||5.015007| |
|
5189 +token_free||| |
|
5190 +token_getmad||| |
|
5191 +tokenize_use||| |
|
5192 +tokeq||| |
|
5193 +tokereport||| |
|
5194 +too_few_arguments_pv||| |
|
5195 +too_few_arguments_sv||| |
|
5196 +too_many_arguments_pv||| |
|
5197 +too_many_arguments_sv||| |
|
5198 +translate_substr_offsets||| |
|
5199 +try_amagic_bin||| |
|
5200 +try_amagic_un||| |
|
5201 +uiv_2buf|||n |
|
5202 +unlnk||| |
|
5203 +unpack_rec||| |
|
5204 +unpack_str||5.007003| |
|
5205 +unpackstring||5.008001| |
|
5206 +unreferenced_to_tmp_stack||| |
|
5207 +unshare_hek_or_pvn||| |
|
5208 +unshare_hek||| |
|
5209 +unsharepvn||5.004000| |
|
5210 +unwind_handler_stack||| |
|
5211 +update_debugger_info||| |
|
5212 +upg_version||5.009005| |
|
5213 +usage||| |
|
5214 +utf16_textfilter||| |
|
5215 +utf16_to_utf8_reversed||5.006001| |
|
5216 +utf16_to_utf8||5.006001| |
|
5217 +utf8_distance||5.006000| |
|
5218 +utf8_hop||5.006000| |
|
5219 +utf8_length||5.007001| |
|
5220 +utf8_mg_len_cache_update||| |
|
5221 +utf8_mg_pos_cache_update||| |
|
5222 +utf8_to_bytes||5.006001| |
|
5223 +utf8_to_uvchr_buf||5.015009| |
|
5224 +utf8_to_uvchr||5.007001| |
|
5225 +utf8_to_uvuni_buf||5.015009| |
|
5226 +utf8_to_uvuni||5.007001| |
|
5227 +utf8n_to_uvchr||| |
|
5228 +utf8n_to_uvuni||5.007001| |
|
5229 +utilize||| |
|
5230 +uvchr_to_utf8_flags||5.007003| |
|
5231 +uvchr_to_utf8||| |
|
5232 +uvuni_to_utf8_flags||5.007003| |
|
5233 +uvuni_to_utf8||5.007001| |
|
5234 +valid_utf8_to_uvchr||| |
|
5235 +valid_utf8_to_uvuni||5.015009| |
|
5236 +validate_proto||| |
|
5237 +validate_suid||| |
|
5238 +varname||| |
|
5239 +vcmp||5.009000| |
|
5240 +vcroak||5.006000| |
|
5241 +vdeb||5.007003| |
|
5242 +vform||5.006000| |
|
5243 +visit||| |
|
5244 +vivify_defelem||| |
|
5245 +vivify_ref||| |
|
5246 +vload_module|5.006000||p |
|
5247 +vmess||5.006000| |
|
5248 +vnewSVpvf|5.006000|5.004000|p |
|
5249 +vnormal||5.009002| |
|
5250 +vnumify||5.009000| |
|
5251 +vstringify||5.009000| |
|
5252 +vverify||5.009003| |
|
5253 +vwarner||5.006000| |
|
5254 +vwarn||5.006000| |
|
5255 +wait4pid||| |
|
5256 +warn_nocontext|||vn |
|
5257 +warn_sv||5.013001| |
|
5258 +warner_nocontext|||vn |
|
5259 +warner|5.006000|5.004000|pv |
|
5260 +warn|||v |
|
5261 +was_lvalue_sub||| |
|
5262 +watch||| |
|
5263 +whichsig_pvn||5.015004| |
|
5264 +whichsig_pv||5.015004| |
|
5265 +whichsig_sv||5.015004| |
|
5266 +whichsig||| |
|
5267 +win32_croak_not_implemented|||n |
|
5268 +with_queued_errors||| |
|
5269 +wrap_op_checker||5.015008| |
|
5270 +write_to_stderr||| |
|
5271 +xmldump_all_perl||| |
|
5272 +xmldump_all||| |
|
5273 +xmldump_attr||| |
|
5274 +xmldump_eval||| |
|
5275 +xmldump_form||| |
|
5276 +xmldump_indent|||v |
|
5277 +xmldump_packsubs_perl||| |
|
5278 +xmldump_packsubs||| |
|
5279 +xmldump_sub_perl||| |
|
5280 +xmldump_sub||| |
|
5281 +xmldump_vindent||| |
|
5282 +xs_apiversion_bootcheck||| |
|
5283 +xs_version_bootcheck||| |
|
5284 +yyerror_pvn||| |
|
5285 +yyerror_pv||| |
|
5286 +yyerror||| |
|
5287 +yylex||| |
|
5288 +yyparse||| |
|
5289 +yyunlex||| |
|
5290 +yywarn||| |
|
5291 +); |
|
5292 + |
|
5293 +if (exists $opt{'list-unsupported'}) { |
|
5294 + my $f; |
|
5295 + for $f (sort { lc $a cmp lc $b } keys %API) { |
|
5296 + next unless $API{$f}{todo}; |
|
5297 + print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; |
|
5298 + } |
|
5299 + exit 0; |
|
5300 +} |
|
5301 + |
|
5302 +# Scan for possible replacement candidates |
|
5303 + |
|
5304 +my(%replace, %need, %hints, %warnings, %depends); |
|
5305 +my $replace = 0; |
|
5306 +my($hint, $define, $function); |
|
5307 + |
|
5308 +sub find_api |
|
5309 +{ |
|
5310 + my $code = shift; |
|
5311 + $code =~ s{ |
|
5312 + / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) |
|
5313 + | "[^"\\]*(?:\\.[^"\\]*)*" |
|
5314 + | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx; |
|
5315 + grep { exists $API{$_} } $code =~ /(\w+)/mg; |
|
5316 +} |
|
5317 + |
|
5318 +while (<DATA>) { |
|
5319 + if ($hint) { |
|
5320 + my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings; |
|
5321 + if (m{^\s*\*\s(.*?)\s*$}) { |
|
5322 + for (@{$hint->[1]}) { |
|
5323 + $h->{$_} ||= ''; # suppress warning with older perls |
|
5324 + $h->{$_} .= "$1\n"; |
|
5325 + } |
|
5326 + } |
|
5327 + else { undef $hint } |
|
5328 + } |
|
5329 + |
|
5330 + $hint = [$1, [split /,?\s+/, $2]] |
|
5331 + if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}; |
|
5332 + |
|
5333 + if ($define) { |
|
5334 + if ($define->[1] =~ /\\$/) { |
|
5335 + $define->[1] .= $_; |
|
5336 + } |
|
5337 + else { |
|
5338 + if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) { |
|
5339 + my @n = find_api($define->[1]); |
|
5340 + push @{$depends{$define->[0]}}, @n if @n |
|
5341 + } |
|
5342 + undef $define; |
|
5343 + } |
|
5344 + } |
|
5345 + |
|
5346 + $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)}; |
|
5347 + |
|
5348 + if ($function) { |
|
5349 + if (/^}/) { |
|
5350 + if (exists $API{$function->[0]}) { |
|
5351 + my @n = find_api($function->[1]); |
|
5352 + push @{$depends{$function->[0]}}, @n if @n |
|
5353 + } |
|
5354 + undef $function; |
|
5355 + } |
|
5356 + else { |
|
5357 + $function->[1] .= $_; |
|
5358 + } |
|
5359 + } |
|
5360 + |
|
5361 + $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)}; |
|
5362 + |
|
5363 + $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; |
|
5364 + $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; |
|
5365 + $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; |
|
5366 + $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; |
|
5367 + |
|
5368 + if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { |
|
5369 + my @deps = map { s/\s+//g; $_ } split /,/, $3; |
|
5370 + my $d; |
|
5371 + for $d (map { s/\s+//g; $_ } split /,/, $1) { |
|
5372 + push @{$depends{$d}}, @deps; |
|
5373 + } |
|
5374 + } |
|
5375 + |
|
5376 + $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; |
|
5377 +} |
|
5378 + |
|
5379 +for (values %depends) { |
|
5380 + my %s; |
|
5381 + $_ = [sort grep !$s{$_}++, @$_]; |
|
5382 +} |
|
5383 + |
|
5384 +if (exists $opt{'api-info'}) { |
|
5385 + my $f; |
|
5386 + my $count = 0; |
|
5387 + my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; |
|
5388 + for $f (sort { lc $a cmp lc $b } keys %API) { |
|
5389 + next unless $f =~ /$match/; |
|
5390 + print "\n=== $f ===\n\n"; |
|
5391 + my $info = 0; |
|
5392 + if ($API{$f}{base} || $API{$f}{todo}) { |
|
5393 + my $base = format_version($API{$f}{base} || $API{$f}{todo}); |
|
5394 + print "Supported at least starting from perl-$base.\n"; |
|
5395 + $info++; |
|
5396 + } |
|
5397 + if ($API{$f}{provided}) { |
|
5398 + my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003"; |
|
5399 + print "Support by $ppport provided back to perl-$todo.\n"; |
|
5400 + print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; |
|
5401 + print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; |
|
5402 + print "\n$hints{$f}" if exists $hints{$f}; |
|
5403 + print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f}; |
|
5404 + $info++; |
|
5405 + } |
|
5406 + print "No portability information available.\n" unless $info; |
|
5407 + $count++; |
|
5408 + } |
|
5409 + $count or print "Found no API matching '$opt{'api-info'}'."; |
|
5410 + print "\n"; |
|
5411 + exit 0; |
|
5412 +} |
|
5413 + |
|
5414 +if (exists $opt{'list-provided'}) { |
|
5415 + my $f; |
|
5416 + for $f (sort { lc $a cmp lc $b } keys %API) { |
|
5417 + next unless $API{$f}{provided}; |
|
5418 + my @flags; |
|
5419 + push @flags, 'explicit' if exists $need{$f}; |
|
5420 + push @flags, 'depend' if exists $depends{$f}; |
|
5421 + push @flags, 'hint' if exists $hints{$f}; |
|
5422 + push @flags, 'warning' if exists $warnings{$f}; |
|
5423 + my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; |
|
5424 + print "$f$flags\n"; |
|
5425 + } |
|
5426 + exit 0; |
|
5427 +} |
|
5428 + |
|
5429 +my @files; |
|
5430 +my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc ); |
|
5431 +my $srcext = join '|', map { quotemeta $_ } @srcext; |
|
5432 + |
|
5433 +if (@ARGV) { |
|
5434 + my %seen; |
|
5435 + for (@ARGV) { |
|
5436 + if (-e) { |
|
5437 + if (-f) { |
|
5438 + push @files, $_ unless $seen{$_}++; |
|
5439 + } |
|
5440 + else { warn "'$_' is not a file.\n" } |
|
5441 + } |
|
5442 + else { |
|
5443 + my @new = grep { -f } glob $_ |
|
5444 + or warn "'$_' does not exist.\n"; |
|
5445 + push @files, grep { !$seen{$_}++ } @new; |
|
5446 + } |
|
5447 + } |
|
5448 +} |
|
5449 +else { |
|
5450 + eval { |
|
5451 + require File::Find; |
|
5452 + File::Find::find(sub { |
|
5453 + $File::Find::name =~ /($srcext)$/i |
|
5454 + and push @files, $File::Find::name; |
|
5455 + }, '.'); |
|
5456 + }; |
|
5457 + if ($@) { |
|
5458 + @files = map { glob "*$_" } @srcext; |
|
5459 + } |
|
5460 +} |
|
5461 + |
|
5462 +if (!@ARGV || $opt{filter}) { |
|
5463 + my(@in, @out); |
|
5464 + my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; |
|
5465 + for (@files) { |
|
5466 + my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i; |
|
5467 + push @{ $out ? \@out : \@in }, $_; |
|
5468 + } |
|
5469 + if (@ARGV && @out) { |
|
5470 + warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); |
|
5471 + } |
|
5472 + @files = @in; |
|
5473 +} |
|
5474 + |
|
5475 +die "No input files given!\n" unless @files; |
|
5476 + |
|
5477 +my(%files, %global, %revreplace); |
|
5478 +%revreplace = reverse %replace; |
|
5479 +my $filename; |
|
5480 +my $patch_opened = 0; |
|
5481 + |
|
5482 +for $filename (@files) { |
|
5483 + unless (open IN, "<$filename") { |
|
5484 + warn "Unable to read from $filename: $!\n"; |
|
5485 + next; |
|
5486 + } |
|
5487 + |
|
5488 + info("Scanning $filename ..."); |
|
5489 + |
|
5490 + my $c = do { local $/; <IN> }; |
|
5491 + close IN; |
|
5492 + |
|
5493 + my %file = (orig => $c, changes => 0); |
|
5494 + |
|
5495 + # Temporarily remove C/XS comments and strings from the code |
|
5496 + my @ccom; |
|
5497 + |
|
5498 + $c =~ s{ |
|
5499 + ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]* |
|
5500 + | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* ) |
|
5501 + | ( ^$HS*\#[^\r\n]* |
|
5502 + | "[^"\\]*(?:\\.[^"\\]*)*" |
|
5503 + | '[^'\\]*(?:\\.[^'\\]*)*' |
|
5504 + | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) ) |
|
5505 + }{ defined $2 and push @ccom, $2; |
|
5506 + defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex; |
|
5507 + |
|
5508 + $file{ccom} = \@ccom; |
|
5509 + $file{code} = $c; |
|
5510 + $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m; |
|
5511 + |
|
5512 + my $func; |
|
5513 + |
|
5514 + for $func (keys %API) { |
|
5515 + my $match = $func; |
|
5516 + $match .= "|$revreplace{$func}" if exists $revreplace{$func}; |
|
5517 + if ($c =~ /\b(?:Perl_)?($match)\b/) { |
|
5518 + $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; |
|
5519 + $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; |
|
5520 + if (exists $API{$func}{provided}) { |
|
5521 + $file{uses_provided}{$func}++; |
|
5522 + if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { |
|
5523 + $file{uses}{$func}++; |
|
5524 + my @deps = rec_depend($func); |
|
5525 + if (@deps) { |
|
5526 + $file{uses_deps}{$func} = \@deps; |
|
5527 + for (@deps) { |
|
5528 + $file{uses}{$_} = 0 unless exists $file{uses}{$_}; |
|
5529 + } |
|
5530 + } |
|
5531 + for ($func, @deps) { |
|
5532 + $file{needs}{$_} = 'static' if exists $need{$_}; |
|
5533 + } |
|
5534 + } |
|
5535 + } |
|
5536 + if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { |
|
5537 + if ($c =~ /\b$func\b/) { |
|
5538 + $file{uses_todo}{$func}++; |
|
5539 + } |
|
5540 + } |
|
5541 + } |
|
5542 + } |
|
5543 + |
|
5544 + while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { |
|
5545 + if (exists $need{$2}) { |
|
5546 + $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; |
|
5547 + } |
|
5548 + else { warning("Possibly wrong #define $1 in $filename") } |
|
5549 + } |
|
5550 + |
|
5551 + for (qw(uses needs uses_todo needed_global needed_static)) { |
|
5552 + for $func (keys %{$file{$_}}) { |
|
5553 + push @{$global{$_}{$func}}, $filename; |
|
5554 + } |
|
5555 + } |
|
5556 + |
|
5557 + $files{$filename} = \%file; |
|
5558 +} |
|
5559 + |
|
5560 +# Globally resolve NEED_'s |
|
5561 +my $need; |
|
5562 +for $need (keys %{$global{needs}}) { |
|
5563 + if (@{$global{needs}{$need}} > 1) { |
|
5564 + my @targets = @{$global{needs}{$need}}; |
|
5565 + my @t = grep $files{$_}{needed_global}{$need}, @targets; |
|
5566 + @targets = @t if @t; |
|
5567 + @t = grep /\.xs$/i, @targets; |
|
5568 + @targets = @t if @t; |
|
5569 + my $target = shift @targets; |
|
5570 + $files{$target}{needs}{$need} = 'global'; |
|
5571 + for (@{$global{needs}{$need}}) { |
|
5572 + $files{$_}{needs}{$need} = 'extern' if $_ ne $target; |
|
5573 + } |
|
5574 + } |
|
5575 +} |
|
5576 + |
|
5577 +for $filename (@files) { |
|
5578 + exists $files{$filename} or next; |
|
5579 + |
|
5580 + info("=== Analyzing $filename ==="); |
|
5581 + |
|
5582 + my %file = %{$files{$filename}}; |
|
5583 + my $func; |
|
5584 + my $c = $file{code}; |
|
5585 + my $warnings = 0; |
|
5586 + |
|
5587 + for $func (sort keys %{$file{uses_Perl}}) { |
|
5588 + if ($API{$func}{varargs}) { |
|
5589 + unless ($API{$func}{nothxarg}) { |
|
5590 + my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} |
|
5591 + { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); |
|
5592 + if ($changes) { |
|
5593 + warning("Doesn't pass interpreter argument aTHX to Perl_$func"); |
|
5594 + $file{changes} += $changes; |
|
5595 + } |
|
5596 + } |
|
5597 + } |
|
5598 + else { |
|
5599 + warning("Uses Perl_$func instead of $func"); |
|
5600 + $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} |
|
5601 + {$func$1(}g); |
|
5602 + } |
|
5603 + } |
|
5604 + |
|
5605 + for $func (sort keys %{$file{uses_replace}}) { |
|
5606 + warning("Uses $func instead of $replace{$func}"); |
|
5607 + $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); |
|
5608 + } |
|
5609 + |
|
5610 + for $func (sort keys %{$file{uses_provided}}) { |
|
5611 + if ($file{uses}{$func}) { |
|
5612 + if (exists $file{uses_deps}{$func}) { |
|
5613 + diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); |
|
5614 + } |
|
5615 + else { |
|
5616 + diag("Uses $func"); |
|
5617 + } |
|
5618 + } |
|
5619 + $warnings += hint($func); |
|
5620 + } |
|
5621 + |
|
5622 + unless ($opt{quiet}) { |
|
5623 + for $func (sort keys %{$file{uses_todo}}) { |
|
5624 + print "*** WARNING: Uses $func, which may not be portable below perl ", |
|
5625 + format_version($API{$func}{todo}), ", even with '$ppport'\n"; |
|
5626 + $warnings++; |
|
5627 + } |
|
5628 + } |
|
5629 + |
|
5630 + for $func (sort keys %{$file{needed_static}}) { |
|
5631 + my $message = ''; |
|
5632 + if (not exists $file{uses}{$func}) { |
|
5633 + $message = "No need to define NEED_$func if $func is never used"; |
|
5634 + } |
|
5635 + elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { |
|
5636 + $message = "No need to define NEED_$func when already needed globally"; |
|
5637 + } |
|
5638 + if ($message) { |
|
5639 + diag($message); |
|
5640 + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); |
|
5641 + } |
|
5642 + } |
|
5643 + |
|
5644 + for $func (sort keys %{$file{needed_global}}) { |
|
5645 + my $message = ''; |
|
5646 + if (not exists $global{uses}{$func}) { |
|
5647 + $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; |
|
5648 + } |
|
5649 + elsif (exists $file{needs}{$func}) { |
|
5650 + if ($file{needs}{$func} eq 'extern') { |
|
5651 + $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; |
|
5652 + } |
|
5653 + elsif ($file{needs}{$func} eq 'static') { |
|
5654 + $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; |
|
5655 + } |
|
5656 + } |
|
5657 + if ($message) { |
|
5658 + diag($message); |
|
5659 + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); |
|
5660 + } |
|
5661 + } |
|
5662 + |
|
5663 + $file{needs_inc_ppport} = keys %{$file{uses}}; |
|
5664 + |
|
5665 + if ($file{needs_inc_ppport}) { |
|
5666 + my $pp = ''; |
|
5667 + |
|
5668 + for $func (sort keys %{$file{needs}}) { |
|
5669 + my $type = $file{needs}{$func}; |
|
5670 + next if $type eq 'extern'; |
|
5671 + my $suffix = $type eq 'global' ? '_GLOBAL' : ''; |
|
5672 + unless (exists $file{"needed_$type"}{$func}) { |
|
5673 + if ($type eq 'global') { |
|
5674 + diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); |
|
5675 + } |
|
5676 + else { |
|
5677 + diag("File needs $func, adding static request"); |
|
5678 + } |
|
5679 + $pp .= "#define NEED_$func$suffix\n"; |
|
5680 + } |
|
5681 + } |
|
5682 + |
|
5683 + if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { |
|
5684 + $pp = ''; |
|
5685 + $file{changes}++; |
|
5686 + } |
|
5687 + |
|
5688 + unless ($file{has_inc_ppport}) { |
|
5689 + diag("Needs to include '$ppport'"); |
|
5690 + $pp .= qq(#include "$ppport"\n) |
|
5691 + } |
|
5692 + |
|
5693 + if ($pp) { |
|
5694 + $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) |
|
5695 + || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) |
|
5696 + || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) |
|
5697 + || ($c =~ s/^/$pp/); |
|
5698 + } |
|
5699 + } |
|
5700 + else { |
|
5701 + if ($file{has_inc_ppport}) { |
|
5702 + diag("No need to include '$ppport'"); |
|
5703 + $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); |
|
5704 + } |
|
5705 + } |
|
5706 + |
|
5707 + # put back in our C comments |
|
5708 + my $ix; |
|
5709 + my $cppc = 0; |
|
5710 + my @ccom = @{$file{ccom}}; |
|
5711 + for $ix (0 .. $#ccom) { |
|
5712 + if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { |
|
5713 + $cppc++; |
|
5714 + $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; |
|
5715 + } |
|
5716 + else { |
|
5717 + $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; |
|
5718 + } |
|
5719 + } |
|
5720 + |
|
5721 + if ($cppc) { |
|
5722 + my $s = $cppc != 1 ? 's' : ''; |
|
5723 + warning("Uses $cppc C++ style comment$s, which is not portable"); |
|
5724 + } |
|
5725 + |
|
5726 + my $s = $warnings != 1 ? 's' : ''; |
|
5727 + my $warn = $warnings ? " ($warnings warning$s)" : ''; |
|
5728 + info("Analysis completed$warn"); |
|
5729 + |
|
5730 + if ($file{changes}) { |
|
5731 + if (exists $opt{copy}) { |
|
5732 + my $newfile = "$filename$opt{copy}"; |
|
5733 + if (-e $newfile) { |
|
5734 + error("'$newfile' already exists, refusing to write copy of '$filename'"); |
|
5735 + } |
|
5736 + else { |
|
5737 + local *F; |
|
5738 + if (open F, ">$newfile") { |
|
5739 + info("Writing copy of '$filename' with changes to '$newfile'"); |
|
5740 + print F $c; |
|
5741 + close F; |
|
5742 + } |
|
5743 + else { |
|
5744 + error("Cannot open '$newfile' for writing: $!"); |
|
5745 + } |
|
5746 + } |
|
5747 + } |
|
5748 + elsif (exists $opt{patch} || $opt{changes}) { |
|
5749 + if (exists $opt{patch}) { |
|
5750 + unless ($patch_opened) { |
|
5751 + if (open PATCH, ">$opt{patch}") { |
|
5752 + $patch_opened = 1; |
|
5753 + } |
|
5754 + else { |
|
5755 + error("Cannot open '$opt{patch}' for writing: $!"); |
|
5756 + delete $opt{patch}; |
|
5757 + $opt{changes} = 1; |
|
5758 + goto fallback; |
|
5759 + } |
|
5760 + } |
|
5761 + mydiff(\*PATCH, $filename, $c); |
|
5762 + } |
|
5763 + else { |
|
5764 +fallback: |
|
5765 + info("Suggested changes:"); |
|
5766 + mydiff(\*STDOUT, $filename, $c); |
|
5767 + } |
|
5768 + } |
|
5769 + else { |
|
5770 + my $s = $file{changes} == 1 ? '' : 's'; |
|
5771 + info("$file{changes} potentially required change$s detected"); |
|
5772 + } |
|
5773 + } |
|
5774 + else { |
|
5775 + info("Looks good"); |
|
5776 + } |
|
5777 +} |
|
5778 + |
|
5779 +close PATCH if $patch_opened; |
|
5780 + |
|
5781 +exit 0; |
|
5782 + |
|
5783 + |
|
5784 +sub try_use { eval "use @_;"; return $@ eq '' } |
|
5785 + |
|
5786 +sub mydiff |
|
5787 +{ |
|
5788 + local *F = shift; |
|
5789 + my($file, $str) = @_; |
|
5790 + my $diff; |
|
5791 + |
|
5792 + if (exists $opt{diff}) { |
|
5793 + $diff = run_diff($opt{diff}, $file, $str); |
|
5794 + } |
|
5795 + |
|
5796 + if (!defined $diff and try_use('Text::Diff')) { |
|
5797 + $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); |
|
5798 + $diff = <<HEADER . $diff; |
|
5799 +--- $file |
|
5800 ++++ $file.patched |
|
5801 +HEADER |
|
5802 + } |
|
5803 + |
|
5804 + if (!defined $diff) { |
|
5805 + $diff = run_diff('diff -u', $file, $str); |
|
5806 + } |
|
5807 + |
|
5808 + if (!defined $diff) { |
|
5809 + $diff = run_diff('diff', $file, $str); |
|
5810 + } |
|
5811 + |
|
5812 + if (!defined $diff) { |
|
5813 + error("Cannot generate a diff. Please install Text::Diff or use --copy."); |
|
5814 + return; |
|
5815 + } |
|
5816 + |
|
5817 + print F $diff; |
|
5818 +} |
|
5819 + |
|
5820 +sub run_diff |
|
5821 +{ |
|
5822 + my($prog, $file, $str) = @_; |
|
5823 + my $tmp = 'dppptemp'; |
|
5824 + my $suf = 'aaa'; |
|
5825 + my $diff = ''; |
|
5826 + local *F; |
|
5827 + |
|
5828 + while (-e "$tmp.$suf") { $suf++ } |
|
5829 + $tmp = "$tmp.$suf"; |
|
5830 + |
|
5831 + if (open F, ">$tmp") { |
|
5832 + print F $str; |
|
5833 + close F; |
|
5834 + |
|
5835 + if (open F, "$prog $file $tmp |") { |
|
5836 + while (<F>) { |
|
5837 + s/\Q$tmp\E/$file.patched/; |
|
5838 + $diff .= $_; |
|
5839 + } |
|
5840 + close F; |
|
5841 + unlink $tmp; |
|
5842 + return $diff; |
|
5843 + } |
|
5844 + |
|
5845 + unlink $tmp; |
|
5846 + } |
|
5847 + else { |
|
5848 + error("Cannot open '$tmp' for writing: $!"); |
|
5849 + } |
|
5850 + |
|
5851 + return undef; |
|
5852 +} |
|
5853 + |
|
5854 +sub rec_depend |
|
5855 +{ |
|
5856 + my($func, $seen) = @_; |
|
5857 + return () unless exists $depends{$func}; |
|
5858 + $seen = {%{$seen||{}}}; |
|
5859 + return () if $seen->{$func}++; |
|
5860 + my %s; |
|
5861 + grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}}; |
|
5862 +} |
|
5863 + |
|
5864 +sub parse_version |
|
5865 +{ |
|
5866 + my $ver = shift; |
|
5867 + |
|
5868 + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { |
|
5869 + return ($1, $2, $3); |
|
5870 + } |
|
5871 + elsif ($ver !~ /^\d+\.[\d_]+$/) { |
|
5872 + die "cannot parse version '$ver'\n"; |
|
5873 + } |
|
5874 + |
|
5875 + $ver =~ s/_//g; |
|
5876 + $ver =~ s/$/000000/; |
|
5877 + |
|
5878 + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; |
|
5879 + |
|
5880 + $v = int $v; |
|
5881 + $s = int $s; |
|
5882 + |
|
5883 + if ($r < 5 || ($r == 5 && $v < 6)) { |
|
5884 + if ($s % 10) { |
|
5885 + die "cannot parse version '$ver'\n"; |
|
5886 + } |
|
5887 + } |
|
5888 + |
|
5889 + return ($r, $v, $s); |
|
5890 +} |
|
5891 + |
|
5892 +sub format_version |
|
5893 +{ |
|
5894 + my $ver = shift; |
|
5895 + |
|
5896 + $ver =~ s/$/000000/; |
|
5897 + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; |
|
5898 + |
|
5899 + $v = int $v; |
|
5900 + $s = int $s; |
|
5901 + |
|
5902 + if ($r < 5 || ($r == 5 && $v < 6)) { |
|
5903 + if ($s % 10) { |
|
5904 + die "invalid version '$ver'\n"; |
|
5905 + } |
|
5906 + $s /= 10; |
|
5907 + |
|
5908 + $ver = sprintf "%d.%03d", $r, $v; |
|
5909 + $s > 0 and $ver .= sprintf "_%02d", $s; |
|
5910 + |
|
5911 + return $ver; |
|
5912 + } |
|
5913 + |
|
5914 + return sprintf "%d.%d.%d", $r, $v, $s; |
|
5915 +} |
|
5916 + |
|
5917 +sub info |
|
5918 +{ |
|
5919 + $opt{quiet} and return; |
|
5920 + print @_, "\n"; |
|
5921 +} |
|
5922 + |
|
5923 +sub diag |
|
5924 +{ |
|
5925 + $opt{quiet} and return; |
|
5926 + $opt{diag} and print @_, "\n"; |
|
5927 +} |
|
5928 + |
|
5929 +sub warning |
|
5930 +{ |
|
5931 + $opt{quiet} and return; |
|
5932 + print "*** ", @_, "\n"; |
|
5933 +} |
|
5934 + |
|
5935 +sub error |
|
5936 +{ |
|
5937 + print "*** ERROR: ", @_, "\n"; |
|
5938 +} |
|
5939 + |
|
5940 +my %given_hints; |
|
5941 +my %given_warnings; |
|
5942 +sub hint |
|
5943 +{ |
|
5944 + $opt{quiet} and return; |
|
5945 + my $func = shift; |
|
5946 + my $rv = 0; |
|
5947 + if (exists $warnings{$func} && !$given_warnings{$func}++) { |
|
5948 + my $warn = $warnings{$func}; |
|
5949 + $warn =~ s!^!*** !mg; |
|
5950 + print "*** WARNING: $func\n", $warn; |
|
5951 + $rv++; |
|
5952 + } |
|
5953 + if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) { |
|
5954 + my $hint = $hints{$func}; |
|
5955 + $hint =~ s/^/ /mg; |
|
5956 + print " --- hint for $func ---\n", $hint; |
|
5957 + } |
|
5958 + $rv; |
|
5959 +} |
|
5960 + |
|
5961 +sub usage |
|
5962 +{ |
|
5963 + my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; |
|
5964 + my %M = ( 'I' => '*' ); |
|
5965 + $usage =~ s/^\s*perl\s+\S+/$^X $0/; |
|
5966 + $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; |
|
5967 + |
|
5968 + print <<ENDUSAGE; |
|
5969 + |
|
5970 +Usage: $usage |
|
5971 + |
|
5972 +See perldoc $0 for details. |
|
5973 + |
|
5974 +ENDUSAGE |
|
5975 + |
|
5976 + exit 2; |
|
5977 +} |
|
5978 + |
|
5979 +sub strip |
|
5980 +{ |
|
5981 + my $self = do { local(@ARGV,$/)=($0); <> }; |
|
5982 + my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms; |
|
5983 + $copy =~ s/^(?=\S+)/ /gms; |
|
5984 + $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms; |
|
5985 + $self =~ s/^SKIP.*(?=^__DATA__)/SKIP |
|
5986 +if (\@ARGV && \$ARGV[0] eq '--unstrip') { |
|
5987 + eval { require Devel::PPPort }; |
|
5988 + \$@ and die "Cannot require Devel::PPPort, please install.\\n"; |
|
5989 + if (eval \$Devel::PPPort::VERSION < $VERSION) { |
|
5990 + die "$0 was originally generated with Devel::PPPort $VERSION.\\n" |
|
5991 + . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n" |
|
5992 + . "Please install a newer version, or --unstrip will not work.\\n"; |
|
5993 + } |
|
5994 + Devel::PPPort::WriteFile(\$0); |
|
5995 + exit 0; |
|
5996 +} |
|
5997 +print <<END; |
|
5998 + |
|
5999 +Sorry, but this is a stripped version of \$0. |
|
6000 + |
|
6001 +To be able to use its original script and doc functionality, |
|
6002 +please try to regenerate this file using: |
|
6003 + |
|
6004 + \$^X \$0 --unstrip |
|
6005 + |
|
6006 +END |
|
6007 +/ms; |
|
6008 + my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms; |
|
6009 + $c =~ s{ |
|
6010 + / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) |
|
6011 + | ( "[^"\\]*(?:\\.[^"\\]*)*" |
|
6012 + | '[^'\\]*(?:\\.[^'\\]*)*' ) |
|
6013 + | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex; |
|
6014 + $c =~ s!\s+$!!mg; |
|
6015 + $c =~ s!^$LF!!mg; |
|
6016 + $c =~ s!^\s*#\s*!#!mg; |
|
6017 + $c =~ s!^\s+!!mg; |
|
6018 + |
|
6019 + open OUT, ">$0" or die "cannot strip $0: $!\n"; |
|
6020 + print OUT "$pl$c\n"; |
|
6021 + |
|
6022 + exit 0; |
|
6023 +} |
|
6024 + |
|
6025 +__DATA__ |
|
6026 +*/ |
|
6027 + |
|
6028 +#ifndef _P_P_PORTABILITY_H_ |
|
6029 +#define _P_P_PORTABILITY_H_ |
|
6030 + |
|
6031 +#ifndef DPPP_NAMESPACE |
|
6032 +# define DPPP_NAMESPACE DPPP_ |
|
6033 +#endif |
|
6034 + |
|
6035 +#define DPPP_CAT2(x,y) CAT2(x,y) |
|
6036 +#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) |
|
6037 + |
|
6038 +#ifndef PERL_REVISION |
|
6039 +# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) |
|
6040 +# define PERL_PATCHLEVEL_H_IMPLICIT |
|
6041 +# include <patchlevel.h> |
|
6042 +# endif |
|
6043 +# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) |
|
6044 +# include <could_not_find_Perl_patchlevel.h> |
|
6045 +# endif |
|
6046 +# ifndef PERL_REVISION |
|
6047 +# define PERL_REVISION (5) |
|
6048 + /* Replace: 1 */ |
|
6049 +# define PERL_VERSION PATCHLEVEL |
|
6050 +# define PERL_SUBVERSION SUBVERSION |
|
6051 + /* Replace PERL_PATCHLEVEL with PERL_VERSION */ |
|
6052 + /* Replace: 0 */ |
|
6053 +# endif |
|
6054 +#endif |
|
6055 + |
|
6056 +#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) |
|
6057 +#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION)) |
|
6058 + |
|
6059 +/* It is very unlikely that anyone will try to use this with Perl 6 |
|
6060 + (or greater), but who knows. |
|
6061 + */ |
|
6062 +#if PERL_REVISION != 5 |
|
6063 +# error ppport.h only works with Perl version 5 |
|
6064 +#endif /* PERL_REVISION != 5 */ |
|
6065 +#ifndef dTHR |
|
6066 +# define dTHR dNOOP |
|
6067 +#endif |
|
6068 +#ifndef dTHX |
|
6069 +# define dTHX dNOOP |
|
6070 +#endif |
|
6071 + |
|
6072 +#ifndef dTHXa |
|
6073 +# define dTHXa(x) dNOOP |
|
6074 +#endif |
|
6075 +#ifndef pTHX |
|
6076 +# define pTHX void |
|
6077 +#endif |
|
6078 + |
|
6079 +#ifndef pTHX_ |
|
6080 +# define pTHX_ |
|
6081 +#endif |
|
6082 + |
|
6083 +#ifndef aTHX |
|
6084 +# define aTHX |
|
6085 +#endif |
|
6086 + |
|
6087 +#ifndef aTHX_ |
|
6088 +# define aTHX_ |
|
6089 +#endif |
|
6090 + |
|
6091 +#if (PERL_BCDVERSION < 0x5006000) |
|
6092 +# ifdef USE_THREADS |
|
6093 +# define aTHXR thr |
|
6094 +# define aTHXR_ thr, |
|
6095 +# else |
|
6096 +# define aTHXR |
|
6097 +# define aTHXR_ |
|
6098 +# endif |
|
6099 +# define dTHXR dTHR |
|
6100 +#else |
|
6101 +# define aTHXR aTHX |
|
6102 +# define aTHXR_ aTHX_ |
|
6103 +# define dTHXR dTHX |
|
6104 +#endif |
|
6105 +#ifndef dTHXoa |
|
6106 +# define dTHXoa(x) dTHXa(x) |
|
6107 +#endif |
|
6108 + |
|
6109 +#ifdef I_LIMITS |
|
6110 +# include <limits.h> |
|
6111 +#endif |
|
6112 + |
|
6113 +#ifndef PERL_UCHAR_MIN |
|
6114 +# define PERL_UCHAR_MIN ((unsigned char)0) |
|
6115 +#endif |
|
6116 + |
|
6117 +#ifndef PERL_UCHAR_MAX |
|
6118 +# ifdef UCHAR_MAX |
|
6119 +# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) |
|
6120 +# else |
|
6121 +# ifdef MAXUCHAR |
|
6122 +# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) |
|
6123 +# else |
|
6124 +# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) |
|
6125 +# endif |
|
6126 +# endif |
|
6127 +#endif |
|
6128 + |
|
6129 +#ifndef PERL_USHORT_MIN |
|
6130 +# define PERL_USHORT_MIN ((unsigned short)0) |
|
6131 +#endif |
|
6132 + |
|
6133 +#ifndef PERL_USHORT_MAX |
|
6134 +# ifdef USHORT_MAX |
|
6135 +# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) |
|
6136 +# else |
|
6137 +# ifdef MAXUSHORT |
|
6138 +# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) |
|
6139 +# else |
|
6140 +# ifdef USHRT_MAX |
|
6141 +# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) |
|
6142 +# else |
|
6143 +# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) |
|
6144 +# endif |
|
6145 +# endif |
|
6146 +# endif |
|
6147 +#endif |
|
6148 + |
|
6149 +#ifndef PERL_SHORT_MAX |
|
6150 +# ifdef SHORT_MAX |
|
6151 +# define PERL_SHORT_MAX ((short)SHORT_MAX) |
|
6152 +# else |
|
6153 +# ifdef MAXSHORT /* Often used in <values.h> */ |
|
6154 +# define PERL_SHORT_MAX ((short)MAXSHORT) |
|
6155 +# else |
|
6156 +# ifdef SHRT_MAX |
|
6157 +# define PERL_SHORT_MAX ((short)SHRT_MAX) |
|
6158 +# else |
|
6159 +# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) |
|
6160 +# endif |
|
6161 +# endif |
|
6162 +# endif |
|
6163 +#endif |
|
6164 + |
|
6165 +#ifndef PERL_SHORT_MIN |
|
6166 +# ifdef SHORT_MIN |
|
6167 +# define PERL_SHORT_MIN ((short)SHORT_MIN) |
|
6168 +# else |
|
6169 +# ifdef MINSHORT |
|
6170 +# define PERL_SHORT_MIN ((short)MINSHORT) |
|
6171 +# else |
|
6172 +# ifdef SHRT_MIN |
|
6173 +# define PERL_SHORT_MIN ((short)SHRT_MIN) |
|
6174 +# else |
|
6175 +# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) |
|
6176 +# endif |
|
6177 +# endif |
|
6178 +# endif |
|
6179 +#endif |
|
6180 + |
|
6181 +#ifndef PERL_UINT_MAX |
|
6182 +# ifdef UINT_MAX |
|
6183 +# define PERL_UINT_MAX ((unsigned int)UINT_MAX) |
|
6184 +# else |
|
6185 +# ifdef MAXUINT |
|
6186 +# define PERL_UINT_MAX ((unsigned int)MAXUINT) |
|
6187 +# else |
|
6188 +# define PERL_UINT_MAX (~(unsigned int)0) |
|
6189 +# endif |
|
6190 +# endif |
|
6191 +#endif |
|
6192 + |
|
6193 +#ifndef PERL_UINT_MIN |
|
6194 +# define PERL_UINT_MIN ((unsigned int)0) |
|
6195 +#endif |
|
6196 + |
|
6197 +#ifndef PERL_INT_MAX |
|
6198 +# ifdef INT_MAX |
|
6199 +# define PERL_INT_MAX ((int)INT_MAX) |
|
6200 +# else |
|
6201 +# ifdef MAXINT /* Often used in <values.h> */ |
|
6202 +# define PERL_INT_MAX ((int)MAXINT) |
|
6203 +# else |
|
6204 +# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) |
|
6205 +# endif |
|
6206 +# endif |
|
6207 +#endif |
|
6208 + |
|
6209 +#ifndef PERL_INT_MIN |
|
6210 +# ifdef INT_MIN |
|
6211 +# define PERL_INT_MIN ((int)INT_MIN) |
|
6212 +# else |
|
6213 +# ifdef MININT |
|
6214 +# define PERL_INT_MIN ((int)MININT) |
|
6215 +# else |
|
6216 +# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) |
|
6217 +# endif |
|
6218 +# endif |
|
6219 +#endif |
|
6220 + |
|
6221 +#ifndef PERL_ULONG_MAX |
|
6222 +# ifdef ULONG_MAX |
|
6223 +# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) |
|
6224 +# else |
|
6225 +# ifdef MAXULONG |
|
6226 +# define PERL_ULONG_MAX ((unsigned long)MAXULONG) |
|
6227 +# else |
|
6228 +# define PERL_ULONG_MAX (~(unsigned long)0) |
|
6229 +# endif |
|
6230 +# endif |
|
6231 +#endif |
|
6232 + |
|
6233 +#ifndef PERL_ULONG_MIN |
|
6234 +# define PERL_ULONG_MIN ((unsigned long)0L) |
|
6235 +#endif |
|
6236 + |
|
6237 +#ifndef PERL_LONG_MAX |
|
6238 +# ifdef LONG_MAX |
|
6239 +# define PERL_LONG_MAX ((long)LONG_MAX) |
|
6240 +# else |
|
6241 +# ifdef MAXLONG |
|
6242 +# define PERL_LONG_MAX ((long)MAXLONG) |
|
6243 +# else |
|
6244 +# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) |
|
6245 +# endif |
|
6246 +# endif |
|
6247 +#endif |
|
6248 + |
|
6249 +#ifndef PERL_LONG_MIN |
|
6250 +# ifdef LONG_MIN |
|
6251 +# define PERL_LONG_MIN ((long)LONG_MIN) |
|
6252 +# else |
|
6253 +# ifdef MINLONG |
|
6254 +# define PERL_LONG_MIN ((long)MINLONG) |
|
6255 +# else |
|
6256 +# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) |
|
6257 +# endif |
|
6258 +# endif |
|
6259 +#endif |
|
6260 + |
|
6261 +#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) |
|
6262 +# ifndef PERL_UQUAD_MAX |
|
6263 +# ifdef ULONGLONG_MAX |
|
6264 +# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) |
|
6265 +# else |
|
6266 +# ifdef MAXULONGLONG |
|
6267 +# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) |
|
6268 +# else |
|
6269 +# define PERL_UQUAD_MAX (~(unsigned long long)0) |
|
6270 +# endif |
|
6271 +# endif |
|
6272 +# endif |
|
6273 + |
|
6274 +# ifndef PERL_UQUAD_MIN |
|
6275 +# define PERL_UQUAD_MIN ((unsigned long long)0L) |
|
6276 +# endif |
|
6277 + |
|
6278 +# ifndef PERL_QUAD_MAX |
|
6279 +# ifdef LONGLONG_MAX |
|
6280 +# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) |
|
6281 +# else |
|
6282 +# ifdef MAXLONGLONG |
|
6283 +# define PERL_QUAD_MAX ((long long)MAXLONGLONG) |
|
6284 +# else |
|
6285 +# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) |
|
6286 +# endif |
|
6287 +# endif |
|
6288 +# endif |
|
6289 + |
|
6290 +# ifndef PERL_QUAD_MIN |
|
6291 +# ifdef LONGLONG_MIN |
|
6292 +# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) |
|
6293 +# else |
|
6294 +# ifdef MINLONGLONG |
|
6295 +# define PERL_QUAD_MIN ((long long)MINLONGLONG) |
|
6296 +# else |
|
6297 +# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) |
|
6298 +# endif |
|
6299 +# endif |
|
6300 +# endif |
|
6301 +#endif |
|
6302 + |
|
6303 +/* This is based on code from 5.003 perl.h */ |
|
6304 +#ifdef HAS_QUAD |
|
6305 +# ifdef cray |
|
6306 +#ifndef IVTYPE |
|
6307 +# define IVTYPE int |
|
6308 +#endif |
|
6309 + |
|
6310 +#ifndef IV_MIN |
|
6311 +# define IV_MIN PERL_INT_MIN |
|
6312 +#endif |
|
6313 + |
|
6314 +#ifndef IV_MAX |
|
6315 +# define IV_MAX PERL_INT_MAX |
|
6316 +#endif |
|
6317 + |
|
6318 +#ifndef UV_MIN |
|
6319 +# define UV_MIN PERL_UINT_MIN |
|
6320 +#endif |
|
6321 + |
|
6322 +#ifndef UV_MAX |
|
6323 +# define UV_MAX PERL_UINT_MAX |
|
6324 +#endif |
|
6325 + |
|
6326 +# ifdef INTSIZE |
|
6327 +#ifndef IVSIZE |
|
6328 +# define IVSIZE INTSIZE |
|
6329 +#endif |
|
6330 + |
|
6331 +# endif |
|
6332 +# else |
|
6333 +# if defined(convex) || defined(uts) |
|
6334 +#ifndef IVTYPE |
|
6335 +# define IVTYPE long long |
|
6336 +#endif |
|
6337 + |
|
6338 +#ifndef IV_MIN |
|
6339 +# define IV_MIN PERL_QUAD_MIN |
|
6340 +#endif |
|
6341 + |
|
6342 +#ifndef IV_MAX |
|
6343 +# define IV_MAX PERL_QUAD_MAX |
|
6344 +#endif |
|
6345 + |
|
6346 +#ifndef UV_MIN |
|
6347 +# define UV_MIN PERL_UQUAD_MIN |
|
6348 +#endif |
|
6349 + |
|
6350 +#ifndef UV_MAX |
|
6351 +# define UV_MAX PERL_UQUAD_MAX |
|
6352 +#endif |
|
6353 + |
|
6354 +# ifdef LONGLONGSIZE |
|
6355 +#ifndef IVSIZE |
|
6356 +# define IVSIZE LONGLONGSIZE |
|
6357 +#endif |
|
6358 + |
|
6359 +# endif |
|
6360 +# else |
|
6361 +#ifndef IVTYPE |
|
6362 +# define IVTYPE long |
|
6363 +#endif |
|
6364 + |
|
6365 +#ifndef IV_MIN |
|
6366 +# define IV_MIN PERL_LONG_MIN |
|
6367 +#endif |
|
6368 + |
|
6369 +#ifndef IV_MAX |
|
6370 +# define IV_MAX PERL_LONG_MAX |
|
6371 +#endif |
|
6372 + |
|
6373 +#ifndef UV_MIN |
|
6374 +# define UV_MIN PERL_ULONG_MIN |
|
6375 +#endif |
|
6376 + |
|
6377 +#ifndef UV_MAX |
|
6378 +# define UV_MAX PERL_ULONG_MAX |
|
6379 +#endif |
|
6380 + |
|
6381 +# ifdef LONGSIZE |
|
6382 +#ifndef IVSIZE |
|
6383 +# define IVSIZE LONGSIZE |
|
6384 +#endif |
|
6385 + |
|
6386 +# endif |
|
6387 +# endif |
|
6388 +# endif |
|
6389 +#ifndef IVSIZE |
|
6390 +# define IVSIZE 8 |
|
6391 +#endif |
|
6392 + |
|
6393 +#ifndef LONGSIZE |
|
6394 +# define LONGSIZE 8 |
|
6395 +#endif |
|
6396 + |
|
6397 +#ifndef PERL_QUAD_MIN |
|
6398 +# define PERL_QUAD_MIN IV_MIN |
|
6399 +#endif |
|
6400 + |
|
6401 +#ifndef PERL_QUAD_MAX |
|
6402 +# define PERL_QUAD_MAX IV_MAX |
|
6403 +#endif |
|
6404 + |
|
6405 +#ifndef PERL_UQUAD_MIN |
|
6406 +# define PERL_UQUAD_MIN UV_MIN |
|
6407 +#endif |
|
6408 + |
|
6409 +#ifndef PERL_UQUAD_MAX |
|
6410 +# define PERL_UQUAD_MAX UV_MAX |
|
6411 +#endif |
|
6412 + |
|
6413 +#else |
|
6414 +#ifndef IVTYPE |
|
6415 +# define IVTYPE long |
|
6416 +#endif |
|
6417 + |
|
6418 +#ifndef LONGSIZE |
|
6419 +# define LONGSIZE 4 |
|
6420 +#endif |
|
6421 + |
|
6422 +#ifndef IV_MIN |
|
6423 +# define IV_MIN PERL_LONG_MIN |
|
6424 +#endif |
|
6425 + |
|
6426 +#ifndef IV_MAX |
|
6427 +# define IV_MAX PERL_LONG_MAX |
|
6428 +#endif |
|
6429 + |
|
6430 +#ifndef UV_MIN |
|
6431 +# define UV_MIN PERL_ULONG_MIN |
|
6432 +#endif |
|
6433 + |
|
6434 +#ifndef UV_MAX |
|
6435 +# define UV_MAX PERL_ULONG_MAX |
|
6436 +#endif |
|
6437 + |
|
6438 +#endif |
|
6439 + |
|
6440 +#ifndef IVSIZE |
|
6441 +# ifdef LONGSIZE |
|
6442 +# define IVSIZE LONGSIZE |
|
6443 +# else |
|
6444 +# define IVSIZE 4 /* A bold guess, but the best we can make. */ |
|
6445 +# endif |
|
6446 +#endif |
|
6447 +#ifndef UVTYPE |
|
6448 +# define UVTYPE unsigned IVTYPE |
|
6449 +#endif |
|
6450 + |
|
6451 +#ifndef UVSIZE |
|
6452 +# define UVSIZE IVSIZE |
|
6453 +#endif |
|
6454 +#ifndef sv_setuv |
|
6455 +# define sv_setuv(sv, uv) \ |
|
6456 + STMT_START { \ |
|
6457 + UV TeMpUv = uv; \ |
|
6458 + if (TeMpUv <= IV_MAX) \ |
|
6459 + sv_setiv(sv, TeMpUv); \ |
|
6460 + else \ |
|
6461 + sv_setnv(sv, (double)TeMpUv); \ |
|
6462 + } STMT_END |
|
6463 +#endif |
|
6464 +#ifndef newSVuv |
|
6465 +# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) |
|
6466 +#endif |
|
6467 +#ifndef sv_2uv |
|
6468 +# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) |
|
6469 +#endif |
|
6470 + |
|
6471 +#ifndef SvUVX |
|
6472 +# define SvUVX(sv) ((UV)SvIVX(sv)) |
|
6473 +#endif |
|
6474 + |
|
6475 +#ifndef SvUVXx |
|
6476 +# define SvUVXx(sv) SvUVX(sv) |
|
6477 +#endif |
|
6478 + |
|
6479 +#ifndef SvUV |
|
6480 +# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) |
|
6481 +#endif |
|
6482 + |
|
6483 +#ifndef SvUVx |
|
6484 +# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) |
|
6485 +#endif |
|
6486 + |
|
6487 +/* Hint: sv_uv |
|
6488 + * Always use the SvUVx() macro instead of sv_uv(). |
|
6489 + */ |
|
6490 +#ifndef sv_uv |
|
6491 +# define sv_uv(sv) SvUVx(sv) |
|
6492 +#endif |
|
6493 + |
|
6494 +#if !defined(SvUOK) && defined(SvIOK_UV) |
|
6495 +# define SvUOK(sv) SvIOK_UV(sv) |
|
6496 +#endif |
|
6497 +#ifndef XST_mUV |
|
6498 +# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) |
|
6499 +#endif |
|
6500 + |
|
6501 +#ifndef XSRETURN_UV |
|
6502 +# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END |
|
6503 +#endif |
|
6504 +#ifndef PUSHu |
|
6505 +# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END |
|
6506 +#endif |
|
6507 + |
|
6508 +#ifndef XPUSHu |
|
6509 +# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END |
|
6510 +#endif |
|
6511 + |
|
6512 +#ifdef HAS_MEMCMP |
|
6513 +#ifndef memNE |
|
6514 +# define memNE(s1,s2,l) (memcmp(s1,s2,l)) |
|
6515 +#endif |
|
6516 + |
|
6517 +#ifndef memEQ |
|
6518 +# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) |
|
6519 +#endif |
|
6520 + |
|
6521 +#else |
|
6522 +#ifndef memNE |
|
6523 +# define memNE(s1,s2,l) (bcmp(s1,s2,l)) |
|
6524 +#endif |
|
6525 + |
|
6526 +#ifndef memEQ |
|
6527 +# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) |
|
6528 +#endif |
|
6529 + |
|
6530 +#endif |
|
6531 +#ifndef memEQs |
|
6532 +# define memEQs(s1, l, s2) \ |
|
6533 + (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1))) |
|
6534 +#endif |
|
6535 + |
|
6536 +#ifndef memNEs |
|
6537 +# define memNEs(s1, l, s2) !memEQs(s1, l, s2) |
|
6538 +#endif |
|
6539 +#ifndef MoveD |
|
6540 +# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) |
|
6541 +#endif |
|
6542 + |
|
6543 +#ifndef CopyD |
|
6544 +# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) |
|
6545 +#endif |
|
6546 + |
|
6547 +#ifdef HAS_MEMSET |
|
6548 +#ifndef ZeroD |
|
6549 +# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) |
|
6550 +#endif |
|
6551 + |
|
6552 +#else |
|
6553 +#ifndef ZeroD |
|
6554 +# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) |
|
6555 +#endif |
|
6556 + |
|
6557 +#endif |
|
6558 +#ifndef PoisonWith |
|
6559 +# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) |
|
6560 +#endif |
|
6561 + |
|
6562 +#ifndef PoisonNew |
|
6563 +# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) |
|
6564 +#endif |
|
6565 + |
|
6566 +#ifndef PoisonFree |
|
6567 +# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) |
|
6568 +#endif |
|
6569 + |
|
6570 +#ifndef Poison |
|
6571 +# define Poison(d,n,t) PoisonFree(d,n,t) |
|
6572 +#endif |
|
6573 +#ifndef Newx |
|
6574 +# define Newx(v,n,t) New(0,v,n,t) |
|
6575 +#endif |
|
6576 + |
|
6577 +#ifndef Newxc |
|
6578 +# define Newxc(v,n,t,c) Newc(0,v,n,t,c) |
|
6579 +#endif |
|
6580 + |
|
6581 +#ifndef Newxz |
|
6582 +# define Newxz(v,n,t) Newz(0,v,n,t) |
|
6583 +#endif |
|
6584 + |
|
6585 +#ifndef PERL_UNUSED_DECL |
|
6586 +# ifdef HASATTRIBUTE |
|
6587 +# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) |
|
6588 +# define PERL_UNUSED_DECL |
|
6589 +# else |
|
6590 +# define PERL_UNUSED_DECL __attribute__((unused)) |
|
6591 +# endif |
|
6592 +# else |
|
6593 +# define PERL_UNUSED_DECL |
|
6594 +# endif |
|
6595 +#endif |
|
6596 + |
|
6597 +#ifndef PERL_UNUSED_ARG |
|
6598 +# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ |
|
6599 +# include <note.h> |
|
6600 +# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) |
|
6601 +# else |
|
6602 +# define PERL_UNUSED_ARG(x) ((void)x) |
|
6603 +# endif |
|
6604 +#endif |
|
6605 + |
|
6606 +#ifndef PERL_UNUSED_VAR |
|
6607 +# define PERL_UNUSED_VAR(x) ((void)x) |
|
6608 +#endif |
|
6609 + |
|
6610 +#ifndef PERL_UNUSED_CONTEXT |
|
6611 +# ifdef USE_ITHREADS |
|
6612 +# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) |
|
6613 +# else |
|
6614 +# define PERL_UNUSED_CONTEXT |
|
6615 +# endif |
|
6616 +#endif |
|
6617 +#ifndef NOOP |
|
6618 +# define NOOP /*EMPTY*/(void)0 |
|
6619 +#endif |
|
6620 + |
|
6621 +#ifndef dNOOP |
|
6622 +# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL |
|
6623 +#endif |
|
6624 + |
|
6625 +#ifndef NVTYPE |
|
6626 +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) |
|
6627 +# define NVTYPE long double |
|
6628 +# else |
|
6629 +# define NVTYPE double |
|
6630 +# endif |
|
6631 +typedef NVTYPE NV; |
|
6632 +#endif |
|
6633 + |
|
6634 +#ifndef INT2PTR |
|
6635 +# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) |
|
6636 +# define PTRV UV |
|
6637 +# define INT2PTR(any,d) (any)(d) |
|
6638 +# else |
|
6639 +# if PTRSIZE == LONGSIZE |
|
6640 +# define PTRV unsigned long |
|
6641 +# else |
|
6642 +# define PTRV unsigned |
|
6643 +# endif |
|
6644 +# define INT2PTR(any,d) (any)(PTRV)(d) |
|
6645 +# endif |
|
6646 +#endif |
|
6647 + |
|
6648 +#ifndef PTR2ul |
|
6649 +# if PTRSIZE == LONGSIZE |
|
6650 +# define PTR2ul(p) (unsigned long)(p) |
|
6651 +# else |
|
6652 +# define PTR2ul(p) INT2PTR(unsigned long,p) |
|
6653 +# endif |
|
6654 +#endif |
|
6655 +#ifndef PTR2nat |
|
6656 +# define PTR2nat(p) (PTRV)(p) |
|
6657 +#endif |
|
6658 + |
|
6659 +#ifndef NUM2PTR |
|
6660 +# define NUM2PTR(any,d) (any)PTR2nat(d) |
|
6661 +#endif |
|
6662 + |
|
6663 +#ifndef PTR2IV |
|
6664 +# define PTR2IV(p) INT2PTR(IV,p) |
|
6665 +#endif |
|
6666 + |
|
6667 +#ifndef PTR2UV |
|
6668 +# define PTR2UV(p) INT2PTR(UV,p) |
|
6669 +#endif |
|
6670 + |
|
6671 +#ifndef PTR2NV |
|
6672 +# define PTR2NV(p) NUM2PTR(NV,p) |
|
6673 +#endif |
|
6674 + |
|
6675 +#undef START_EXTERN_C |
|
6676 +#undef END_EXTERN_C |
|
6677 +#undef EXTERN_C |
|
6678 +#ifdef __cplusplus |
|
6679 +# define START_EXTERN_C extern "C" { |
|
6680 +# define END_EXTERN_C } |
|
6681 +# define EXTERN_C extern "C" |
|
6682 +#else |
|
6683 +# define START_EXTERN_C |
|
6684 +# define END_EXTERN_C |
|
6685 +# define EXTERN_C extern |
|
6686 +#endif |
|
6687 + |
|
6688 +#if defined(PERL_GCC_PEDANTIC) |
|
6689 +# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN |
|
6690 +# define PERL_GCC_BRACE_GROUPS_FORBIDDEN |
|
6691 +# endif |
|
6692 +#endif |
|
6693 + |
|
6694 +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) |
|
6695 +# ifndef PERL_USE_GCC_BRACE_GROUPS |
|
6696 +# define PERL_USE_GCC_BRACE_GROUPS |
|
6697 +# endif |
|
6698 +#endif |
|
6699 + |
|
6700 +#undef STMT_START |
|
6701 +#undef STMT_END |
|
6702 +#ifdef PERL_USE_GCC_BRACE_GROUPS |
|
6703 +# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ |
|
6704 +# define STMT_END ) |
|
6705 +#else |
|
6706 +# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) |
|
6707 +# define STMT_START if (1) |
|
6708 +# define STMT_END else (void)0 |
|
6709 +# else |
|
6710 +# define STMT_START do |
|
6711 +# define STMT_END while (0) |
|
6712 +# endif |
|
6713 +#endif |
|
6714 +#ifndef boolSV |
|
6715 +# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) |
|
6716 +#endif |
|
6717 + |
|
6718 +/* DEFSV appears first in 5.004_56 */ |
|
6719 +#ifndef DEFSV |
|
6720 +# define DEFSV GvSV(PL_defgv) |
|
6721 +#endif |
|
6722 + |
|
6723 +#ifndef SAVE_DEFSV |
|
6724 +# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) |
|
6725 +#endif |
|
6726 + |
|
6727 +#ifndef DEFSV_set |
|
6728 +# define DEFSV_set(sv) (DEFSV = (sv)) |
|
6729 +#endif |
|
6730 + |
|
6731 +/* Older perls (<=5.003) lack AvFILLp */ |
|
6732 +#ifndef AvFILLp |
|
6733 +# define AvFILLp AvFILL |
|
6734 +#endif |
|
6735 +#ifndef ERRSV |
|
6736 +# define ERRSV get_sv("@",FALSE) |
|
6737 +#endif |
|
6738 + |
|
6739 +/* Hint: gv_stashpvn |
|
6740 + * This function's backport doesn't support the length parameter, but |
|
6741 + * rather ignores it. Portability can only be ensured if the length |
|
6742 + * parameter is used for speed reasons, but the length can always be |
|
6743 + * correctly computed from the string argument. |
|
6744 + */ |
|
6745 +#ifndef gv_stashpvn |
|
6746 +# define gv_stashpvn(str,len,create) gv_stashpv(str,create) |
|
6747 +#endif |
|
6748 + |
|
6749 +/* Replace: 1 */ |
|
6750 +#ifndef get_cv |
|
6751 +# define get_cv perl_get_cv |
|
6752 +#endif |
|
6753 + |
|
6754 +#ifndef get_sv |
|
6755 +# define get_sv perl_get_sv |
|
6756 +#endif |
|
6757 + |
|
6758 +#ifndef get_av |
|
6759 +# define get_av perl_get_av |
|
6760 +#endif |
|
6761 + |
|
6762 +#ifndef get_hv |
|
6763 +# define get_hv perl_get_hv |
|
6764 +#endif |
|
6765 + |
|
6766 +/* Replace: 0 */ |
|
6767 +#ifndef dUNDERBAR |
|
6768 +# define dUNDERBAR dNOOP |
|
6769 +#endif |
|
6770 + |
|
6771 +#ifndef UNDERBAR |
|
6772 +# define UNDERBAR DEFSV |
|
6773 +#endif |
|
6774 +#ifndef dAX |
|
6775 +# define dAX I32 ax = MARK - PL_stack_base + 1 |
|
6776 +#endif |
|
6777 + |
|
6778 +#ifndef dITEMS |
|
6779 +# define dITEMS I32 items = SP - MARK |
|
6780 +#endif |
|
6781 +#ifndef dXSTARG |
|
6782 +# define dXSTARG SV * targ = sv_newmortal() |
|
6783 +#endif |
|
6784 +#ifndef dAXMARK |
|
6785 +# define dAXMARK I32 ax = POPMARK; \ |
|
6786 + register SV ** const mark = PL_stack_base + ax++ |
|
6787 +#endif |
|
6788 +#ifndef XSprePUSH |
|
6789 +# define XSprePUSH (sp = PL_stack_base + ax - 1) |
|
6790 +#endif |
|
6791 + |
|
6792 +#if (PERL_BCDVERSION < 0x5005000) |
|
6793 +# undef XSRETURN |
|
6794 +# define XSRETURN(off) \ |
|
6795 + STMT_START { \ |
|
6796 + PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ |
|
6797 + return; \ |
|
6798 + } STMT_END |
|
6799 +#endif |
|
6800 +#ifndef XSPROTO |
|
6801 +# define XSPROTO(name) void name(pTHX_ CV* cv) |
|
6802 +#endif |
|
6803 + |
|
6804 +#ifndef SVfARG |
|
6805 +# define SVfARG(p) ((void*)(p)) |
|
6806 +#endif |
|
6807 +#ifndef PERL_ABS |
|
6808 +# define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) |
|
6809 +#endif |
|
6810 +#ifndef dVAR |
|
6811 +# define dVAR dNOOP |
|
6812 +#endif |
|
6813 +#ifndef SVf |
|
6814 +# define SVf "_" |
|
6815 +#endif |
|
6816 +#ifndef UTF8_MAXBYTES |
|
6817 +# define UTF8_MAXBYTES UTF8_MAXLEN |
|
6818 +#endif |
|
6819 +#ifndef CPERLscope |
|
6820 +# define CPERLscope(x) x |
|
6821 +#endif |
|
6822 +#ifndef PERL_HASH |
|
6823 +# define PERL_HASH(hash,str,len) \ |
|
6824 + STMT_START { \ |
|
6825 + const char *s_PeRlHaSh = str; \ |
|
6826 + I32 i_PeRlHaSh = len; \ |
|
6827 + U32 hash_PeRlHaSh = 0; \ |
|
6828 + while (i_PeRlHaSh--) \ |
|
6829 + hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ |
|
6830 + (hash) = hash_PeRlHaSh; \ |
|
6831 + } STMT_END |
|
6832 +#endif |
|
6833 + |
|
6834 +#ifndef PERLIO_FUNCS_DECL |
|
6835 +# ifdef PERLIO_FUNCS_CONST |
|
6836 +# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs |
|
6837 +# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) |
|
6838 +# else |
|
6839 +# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs |
|
6840 +# define PERLIO_FUNCS_CAST(funcs) (funcs) |
|
6841 +# endif |
|
6842 +#endif |
|
6843 + |
|
6844 +/* provide these typedefs for older perls */ |
|
6845 +#if (PERL_BCDVERSION < 0x5009003) |
|
6846 + |
|
6847 +# ifdef ARGSproto |
|
6848 +typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto); |
|
6849 +# else |
|
6850 +typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); |
|
6851 +# endif |
|
6852 + |
|
6853 +typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); |
|
6854 + |
|
6855 +#endif |
|
6856 +#ifndef isPSXSPC |
|
6857 +# define isPSXSPC(c) (isSPACE(c) || (c) == '\v') |
|
6858 +#endif |
|
6859 + |
|
6860 +#ifndef isBLANK |
|
6861 +# define isBLANK(c) ((c) == ' ' || (c) == '\t') |
|
6862 +#endif |
|
6863 + |
|
6864 +#ifdef EBCDIC |
|
6865 +#ifndef isALNUMC |
|
6866 +# define isALNUMC(c) isalnum(c) |
|
6867 +#endif |
|
6868 + |
|
6869 +#ifndef isASCII |
|
6870 +# define isASCII(c) isascii(c) |
|
6871 +#endif |
|
6872 + |
|
6873 +#ifndef isCNTRL |
|
6874 +# define isCNTRL(c) iscntrl(c) |
|
6875 +#endif |
|
6876 + |
|
6877 +#ifndef isGRAPH |
|
6878 +# define isGRAPH(c) isgraph(c) |
|
6879 +#endif |
|
6880 + |
|
6881 +#ifndef isPRINT |
|
6882 +# define isPRINT(c) isprint(c) |
|
6883 +#endif |
|
6884 + |
|
6885 +#ifndef isPUNCT |
|
6886 +# define isPUNCT(c) ispunct(c) |
|
6887 +#endif |
|
6888 + |
|
6889 +#ifndef isXDIGIT |
|
6890 +# define isXDIGIT(c) isxdigit(c) |
|
6891 +#endif |
|
6892 + |
|
6893 +#else |
|
6894 +# if (PERL_BCDVERSION < 0x5010000) |
|
6895 +/* Hint: isPRINT |
|
6896 + * The implementation in older perl versions includes all of the |
|
6897 + * isSPACE() characters, which is wrong. The version provided by |
|
6898 + * Devel::PPPort always overrides a present buggy version. |
|
6899 + */ |
|
6900 +# undef isPRINT |
|
6901 +# endif |
|
6902 + |
|
6903 +#ifdef HAS_QUAD |
|
6904 +# define WIDEST_UTYPE U64TYPE |
|
6905 +#else |
|
6906 +# define WIDEST_UTYPE U32 |
|
6907 +#endif |
|
6908 +#ifndef isALNUMC |
|
6909 +# define isALNUMC(c) (isALPHA(c) || isDIGIT(c)) |
|
6910 +#endif |
|
6911 + |
|
6912 +#ifndef isASCII |
|
6913 +# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127) |
|
6914 +#endif |
|
6915 + |
|
6916 +#ifndef isCNTRL |
|
6917 +# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127) |
|
6918 +#endif |
|
6919 + |
|
6920 +#ifndef isGRAPH |
|
6921 +# define isGRAPH(c) (isALNUM(c) || isPUNCT(c)) |
|
6922 +#endif |
|
6923 + |
|
6924 +#ifndef isPRINT |
|
6925 +# define isPRINT(c) (((c) >= 32 && (c) < 127)) |
|
6926 +#endif |
|
6927 + |
|
6928 +#ifndef isPUNCT |
|
6929 +# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126)) |
|
6930 +#endif |
|
6931 + |
|
6932 +#ifndef isXDIGIT |
|
6933 +# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F')) |
|
6934 +#endif |
|
6935 + |
|
6936 +#endif |
|
6937 + |
|
6938 +#ifndef PERL_SIGNALS_UNSAFE_FLAG |
|
6939 + |
|
6940 +#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 |
|
6941 + |
|
6942 +#if (PERL_BCDVERSION < 0x5008000) |
|
6943 +# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG |
|
6944 +#else |
|
6945 +# define D_PPP_PERL_SIGNALS_INIT 0 |
|
6946 +#endif |
|
6947 + |
|
6948 +#if defined(NEED_PL_signals) |
|
6949 +static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT; |
|
6950 +#elif defined(NEED_PL_signals_GLOBAL) |
|
6951 +U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT; |
|
6952 +#else |
|
6953 +extern U32 DPPP_(my_PL_signals); |
|
6954 +#endif |
|
6955 +#define PL_signals DPPP_(my_PL_signals) |
|
6956 + |
|
6957 +#endif |
|
6958 + |
|
6959 +/* Hint: PL_ppaddr |
|
6960 + * Calling an op via PL_ppaddr requires passing a context argument |
|
6961 + * for threaded builds. Since the context argument is different for |
|
6962 + * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will |
|
6963 + * automatically be defined as the correct argument. |
|
6964 + */ |
|
6965 + |
|
6966 +#if (PERL_BCDVERSION <= 0x5005005) |
|
6967 +/* Replace: 1 */ |
|
6968 +# define PL_ppaddr ppaddr |
|
6969 +# define PL_no_modify no_modify |
|
6970 +/* Replace: 0 */ |
|
6971 +#endif |
|
6972 + |
|
6973 +#if (PERL_BCDVERSION <= 0x5004005) |
|
6974 +/* Replace: 1 */ |
|
6975 +# define PL_DBsignal DBsignal |
|
6976 +# define PL_DBsingle DBsingle |
|
6977 +# define PL_DBsub DBsub |
|
6978 +# define PL_DBtrace DBtrace |
|
6979 +# define PL_Sv Sv |
|
6980 +# define PL_bufend bufend |
|
6981 +# define PL_bufptr bufptr |
|
6982 +# define PL_compiling compiling |
|
6983 +# define PL_copline copline |
|
6984 +# define PL_curcop curcop |
|
6985 +# define PL_curstash curstash |
|
6986 +# define PL_debstash debstash |
|
6987 +# define PL_defgv defgv |
|
6988 +# define PL_diehook diehook |
|
6989 +# define PL_dirty dirty |
|
6990 +# define PL_dowarn dowarn |
|
6991 +# define PL_errgv errgv |
|
6992 +# define PL_error_count error_count |
|
6993 +# define PL_expect expect |
|
6994 +# define PL_hexdigit hexdigit |
|
6995 +# define PL_hints hints |
|
6996 +# define PL_in_my in_my |
|
6997 +# define PL_laststatval laststatval |
|
6998 +# define PL_lex_state lex_state |
|
6999 +# define PL_lex_stuff lex_stuff |
|
7000 +# define PL_linestr linestr |
|
7001 +# define PL_na na |
|
7002 +# define PL_perl_destruct_level perl_destruct_level |
|
7003 +# define PL_perldb perldb |
|
7004 +# define PL_rsfp_filters rsfp_filters |
|
7005 +# define PL_rsfp rsfp |
|
7006 +# define PL_stack_base stack_base |
|
7007 +# define PL_stack_sp stack_sp |
|
7008 +# define PL_statcache statcache |
|
7009 +# define PL_stdingv stdingv |
|
7010 +# define PL_sv_arenaroot sv_arenaroot |
|
7011 +# define PL_sv_no sv_no |
|
7012 +# define PL_sv_undef sv_undef |
|
7013 +# define PL_sv_yes sv_yes |
|
7014 +# define PL_tainted tainted |
|
7015 +# define PL_tainting tainting |
|
7016 +# define PL_tokenbuf tokenbuf |
|
7017 +/* Replace: 0 */ |
|
7018 +#endif |
|
7019 + |
|
7020 +/* Warning: PL_parser |
|
7021 + * For perl versions earlier than 5.9.5, this is an always |
|
7022 + * non-NULL dummy. Also, it cannot be dereferenced. Don't |
|
7023 + * use it if you can avoid is and unless you absolutely know |
|
7024 + * what you're doing. |
|
7025 + * If you always check that PL_parser is non-NULL, you can |
|
7026 + * define DPPP_PL_parser_NO_DUMMY to avoid the creation of |
|
7027 + * a dummy parser structure. |
|
7028 + */ |
|
7029 + |
|
7030 +#if (PERL_BCDVERSION >= 0x5009005) |
|
7031 +# ifdef DPPP_PL_parser_NO_DUMMY |
|
7032 +# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ |
|
7033 + (croak("panic: PL_parser == NULL in %s:%d", \ |
|
7034 + __FILE__, __LINE__), (yy_parser *) NULL))->var) |
|
7035 +# else |
|
7036 +# ifdef DPPP_PL_parser_NO_DUMMY_WARNING |
|
7037 +# define D_PPP_parser_dummy_warning(var) |
|
7038 +# else |
|
7039 +# define D_PPP_parser_dummy_warning(var) \ |
|
7040 + warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__), |
|
7041 +# endif |
|
7042 +# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ |
|
7043 + (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var) |
|
7044 +#if defined(NEED_PL_parser) |
|
7045 +static yy_parser DPPP_(dummy_PL_parser); |
|
7046 +#elif defined(NEED_PL_parser_GLOBAL) |
|
7047 +yy_parser DPPP_(dummy_PL_parser); |
|
7048 +#else |
|
7049 +extern yy_parser DPPP_(dummy_PL_parser); |
|
7050 +#endif |
|
7051 + |
|
7052 +# endif |
|
7053 + |
|
7054 +/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */ |
|
7055 +/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf |
|
7056 + * Do not use this variable unless you know exactly what you're |
|
7057 + * doint. It is internal to the perl parser and may change or even |
|
7058 + * be removed in the future. As of perl 5.9.5, you have to check |
|
7059 + * for (PL_parser != NULL) for this variable to have any effect. |
|
7060 + * An always non-NULL PL_parser dummy is provided for earlier |
|
7061 + * perl versions. |
|
7062 + * If PL_parser is NULL when you try to access this variable, a |
|
7063 + * dummy is being accessed instead and a warning is issued unless |
|
7064 + * you define DPPP_PL_parser_NO_DUMMY_WARNING. |
|
7065 + * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access |
|
7066 + * this variable will croak with a panic message. |
|
7067 + */ |
|
7068 + |
|
7069 +# define PL_expect D_PPP_my_PL_parser_var(expect) |
|
7070 +# define PL_copline D_PPP_my_PL_parser_var(copline) |
|
7071 +# define PL_rsfp D_PPP_my_PL_parser_var(rsfp) |
|
7072 +# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters) |
|
7073 +# define PL_linestr D_PPP_my_PL_parser_var(linestr) |
|
7074 +# define PL_bufptr D_PPP_my_PL_parser_var(bufptr) |
|
7075 +# define PL_bufend D_PPP_my_PL_parser_var(bufend) |
|
7076 +# define PL_lex_state D_PPP_my_PL_parser_var(lex_state) |
|
7077 +# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff) |
|
7078 +# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf) |
|
7079 +# define PL_in_my D_PPP_my_PL_parser_var(in_my) |
|
7080 +# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash) |
|
7081 +# define PL_error_count D_PPP_my_PL_parser_var(error_count) |
|
7082 + |
|
7083 + |
|
7084 +#else |
|
7085 + |
|
7086 +/* ensure that PL_parser != NULL and cannot be dereferenced */ |
|
7087 +# define PL_parser ((void *) 1) |
|
7088 + |
|
7089 +#endif |
|
7090 +#ifndef mPUSHs |
|
7091 +# define mPUSHs(s) PUSHs(sv_2mortal(s)) |
|
7092 +#endif |
|
7093 + |
|
7094 +#ifndef PUSHmortal |
|
7095 +# define PUSHmortal PUSHs(sv_newmortal()) |
|
7096 +#endif |
|
7097 + |
|
7098 +#ifndef mPUSHp |
|
7099 +# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l)) |
|
7100 +#endif |
|
7101 + |
|
7102 +#ifndef mPUSHn |
|
7103 +# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) |
|
7104 +#endif |
|
7105 + |
|
7106 +#ifndef mPUSHi |
|
7107 +# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) |
|
7108 +#endif |
|
7109 + |
|
7110 +#ifndef mPUSHu |
|
7111 +# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) |
|
7112 +#endif |
|
7113 +#ifndef mXPUSHs |
|
7114 +# define mXPUSHs(s) XPUSHs(sv_2mortal(s)) |
|
7115 +#endif |
|
7116 + |
|
7117 +#ifndef XPUSHmortal |
|
7118 +# define XPUSHmortal XPUSHs(sv_newmortal()) |
|
7119 +#endif |
|
7120 + |
|
7121 +#ifndef mXPUSHp |
|
7122 +# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END |
|
7123 +#endif |
|
7124 + |
|
7125 +#ifndef mXPUSHn |
|
7126 +# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END |
|
7127 +#endif |
|
7128 + |
|
7129 +#ifndef mXPUSHi |
|
7130 +# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END |
|
7131 +#endif |
|
7132 + |
|
7133 +#ifndef mXPUSHu |
|
7134 +# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END |
|
7135 +#endif |
|
7136 + |
|
7137 +/* Replace: 1 */ |
|
7138 +#ifndef call_sv |
|
7139 +# define call_sv perl_call_sv |
|
7140 +#endif |
|
7141 + |
|
7142 +#ifndef call_pv |
|
7143 +# define call_pv perl_call_pv |
|
7144 +#endif |
|
7145 + |
|
7146 +#ifndef call_argv |
|
7147 +# define call_argv perl_call_argv |
|
7148 +#endif |
|
7149 + |
|
7150 +#ifndef call_method |
|
7151 +# define call_method perl_call_method |
|
7152 +#endif |
|
7153 +#ifndef eval_sv |
|
7154 +# define eval_sv perl_eval_sv |
|
7155 +#endif |
|
7156 + |
|
7157 +/* Replace: 0 */ |
|
7158 +#ifndef PERL_LOADMOD_DENY |
|
7159 +# define PERL_LOADMOD_DENY 0x1 |
|
7160 +#endif |
|
7161 + |
|
7162 +#ifndef PERL_LOADMOD_NOIMPORT |
|
7163 +# define PERL_LOADMOD_NOIMPORT 0x2 |
|
7164 +#endif |
|
7165 + |
|
7166 +#ifndef PERL_LOADMOD_IMPORT_OPS |
|
7167 +# define PERL_LOADMOD_IMPORT_OPS 0x4 |
|
7168 +#endif |
|
7169 + |
|
7170 +#ifndef G_METHOD |
|
7171 +# define G_METHOD 64 |
|
7172 +# ifdef call_sv |
|
7173 +# undef call_sv |
|
7174 +# endif |
|
7175 +# if (PERL_BCDVERSION < 0x5006000) |
|
7176 +# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \ |
|
7177 + (flags) & ~G_METHOD) : perl_call_sv(sv, flags)) |
|
7178 +# else |
|
7179 +# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \ |
|
7180 + (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags)) |
|
7181 +# endif |
|
7182 +#endif |
|
7183 + |
|
7184 +/* Replace perl_eval_pv with eval_pv */ |
|
7185 + |
|
7186 +#ifndef eval_pv |
|
7187 +#if defined(NEED_eval_pv) |
|
7188 +static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); |
|
7189 +static |
|
7190 +#else |
|
7191 +extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); |
|
7192 +#endif |
|
7193 + |
|
7194 +#ifdef eval_pv |
|
7195 +# undef eval_pv |
|
7196 +#endif |
|
7197 +#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b) |
|
7198 +#define Perl_eval_pv DPPP_(my_eval_pv) |
|
7199 + |
|
7200 +#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) |
|
7201 + |
|
7202 +SV* |
|
7203 +DPPP_(my_eval_pv)(char *p, I32 croak_on_error) |
|
7204 +{ |
|
7205 + dSP; |
|
7206 + SV* sv = newSVpv(p, 0); |
|
7207 + |
|
7208 + PUSHMARK(sp); |
|
7209 + eval_sv(sv, G_SCALAR); |
|
7210 + SvREFCNT_dec(sv); |
|
7211 + |
|
7212 + SPAGAIN; |
|
7213 + sv = POPs; |
|
7214 + PUTBACK; |
|
7215 + |
|
7216 + if (croak_on_error && SvTRUE(GvSV(errgv))) |
|
7217 + croak(SvPVx(GvSV(errgv), na)); |
|
7218 + |
|
7219 + return sv; |
|
7220 +} |
|
7221 + |
|
7222 +#endif |
|
7223 +#endif |
|
7224 + |
|
7225 +#ifndef vload_module |
|
7226 +#if defined(NEED_vload_module) |
|
7227 +static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args); |
|
7228 +static |
|
7229 +#else |
|
7230 +extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args); |
|
7231 +#endif |
|
7232 + |
|
7233 +#ifdef vload_module |
|
7234 +# undef vload_module |
|
7235 +#endif |
|
7236 +#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d) |
|
7237 +#define Perl_vload_module DPPP_(my_vload_module) |
|
7238 + |
|
7239 +#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL) |
|
7240 + |
|
7241 +void |
|
7242 +DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args) |
|
7243 +{ |
|
7244 + dTHR; |
|
7245 + dVAR; |
|
7246 + OP *veop, *imop; |
|
7247 + |
|
7248 + OP * const modname = newSVOP(OP_CONST, 0, name); |
|
7249 + /* 5.005 has a somewhat hacky force_normal that doesn't croak on |
|
7250 + SvREADONLY() if PL_compling is true. Current perls take care in |
|
7251 + ck_require() to correctly turn off SvREADONLY before calling |
|
7252 + force_normal_flags(). This seems a better fix than fudging PL_compling |
|
7253 + */ |
|
7254 + SvREADONLY_off(((SVOP*)modname)->op_sv); |
|
7255 + modname->op_private |= OPpCONST_BARE; |
|
7256 + if (ver) { |
|
7257 + veop = newSVOP(OP_CONST, 0, ver); |
|
7258 + } |
|
7259 + else |
|
7260 + veop = NULL; |
|
7261 + if (flags & PERL_LOADMOD_NOIMPORT) { |
|
7262 + imop = sawparens(newNULLLIST()); |
|
7263 + } |
|
7264 + else if (flags & PERL_LOADMOD_IMPORT_OPS) { |
|
7265 + imop = va_arg(*args, OP*); |
|
7266 + } |
|
7267 + else { |
|
7268 + SV *sv; |
|
7269 + imop = NULL; |
|
7270 + sv = va_arg(*args, SV*); |
|
7271 + while (sv) { |
|
7272 + imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv)); |
|
7273 + sv = va_arg(*args, SV*); |
|
7274 + } |
|
7275 + } |
|
7276 + { |
|
7277 + const line_t ocopline = PL_copline; |
|
7278 + COP * const ocurcop = PL_curcop; |
|
7279 + const int oexpect = PL_expect; |
|
7280 + |
|
7281 +#if (PERL_BCDVERSION >= 0x5004000) |
|
7282 + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), |
|
7283 + veop, modname, imop); |
|
7284 +#else |
|
7285 + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), |
|
7286 + modname, imop); |
|
7287 +#endif |
|
7288 + PL_expect = oexpect; |
|
7289 + PL_copline = ocopline; |
|
7290 + PL_curcop = ocurcop; |
|
7291 + } |
|
7292 +} |
|
7293 + |
|
7294 +#endif |
|
7295 +#endif |
|
7296 + |
|
7297 +#ifndef load_module |
|
7298 +#if defined(NEED_load_module) |
|
7299 +static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...); |
|
7300 +static |
|
7301 +#else |
|
7302 +extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...); |
|
7303 +#endif |
|
7304 + |
|
7305 +#ifdef load_module |
|
7306 +# undef load_module |
|
7307 +#endif |
|
7308 +#define load_module DPPP_(my_load_module) |
|
7309 +#define Perl_load_module DPPP_(my_load_module) |
|
7310 + |
|
7311 +#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL) |
|
7312 + |
|
7313 +void |
|
7314 +DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...) |
|
7315 +{ |
|
7316 + va_list args; |
|
7317 + va_start(args, ver); |
|
7318 + vload_module(flags, name, ver, &args); |
|
7319 + va_end(args); |
|
7320 +} |
|
7321 + |
|
7322 +#endif |
|
7323 +#endif |
|
7324 +#ifndef newRV_inc |
|
7325 +# define newRV_inc(sv) newRV(sv) /* Replace */ |
|
7326 +#endif |
|
7327 + |
|
7328 +#ifndef newRV_noinc |
|
7329 +#if defined(NEED_newRV_noinc) |
|
7330 +static SV * DPPP_(my_newRV_noinc)(SV *sv); |
|
7331 +static |
|
7332 +#else |
|
7333 +extern SV * DPPP_(my_newRV_noinc)(SV *sv); |
|
7334 +#endif |
|
7335 + |
|
7336 +#ifdef newRV_noinc |
|
7337 +# undef newRV_noinc |
|
7338 +#endif |
|
7339 +#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a) |
|
7340 +#define Perl_newRV_noinc DPPP_(my_newRV_noinc) |
|
7341 + |
|
7342 +#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) |
|
7343 +SV * |
|
7344 +DPPP_(my_newRV_noinc)(SV *sv) |
|
7345 +{ |
|
7346 + SV *rv = (SV *)newRV(sv); |
|
7347 + SvREFCNT_dec(sv); |
|
7348 + return rv; |
|
7349 +} |
|
7350 +#endif |
|
7351 +#endif |
|
7352 + |
|
7353 +/* Hint: newCONSTSUB |
|
7354 + * Returns a CV* as of perl-5.7.1. This return value is not supported |
|
7355 + * by Devel::PPPort. |
|
7356 + */ |
|
7357 + |
|
7358 +/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ |
|
7359 +#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005) |
|
7360 +#if defined(NEED_newCONSTSUB) |
|
7361 +static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv); |
|
7362 +static |
|
7363 +#else |
|
7364 +extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv); |
|
7365 +#endif |
|
7366 + |
|
7367 +#ifdef newCONSTSUB |
|
7368 +# undef newCONSTSUB |
|
7369 +#endif |
|
7370 +#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c) |
|
7371 +#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) |
|
7372 + |
|
7373 +#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) |
|
7374 + |
|
7375 +/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */ |
|
7376 +/* (There's no PL_parser in perl < 5.005, so this is completely safe) */ |
|
7377 +#define D_PPP_PL_copline PL_copline |
|
7378 + |
|
7379 +void |
|
7380 +DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv) |
|
7381 +{ |
|
7382 + U32 oldhints = PL_hints; |
|
7383 + HV *old_cop_stash = PL_curcop->cop_stash; |
|
7384 + HV *old_curstash = PL_curstash; |
|
7385 + line_t oldline = PL_curcop->cop_line; |
|
7386 + PL_curcop->cop_line = D_PPP_PL_copline; |
|
7387 + |
|
7388 + PL_hints &= ~HINT_BLOCK_SCOPE; |
|
7389 + if (stash) |
|
7390 + PL_curstash = PL_curcop->cop_stash = stash; |
|
7391 + |
|
7392 + newSUB( |
|
7393 + |
|
7394 +#if (PERL_BCDVERSION < 0x5003022) |
|
7395 + start_subparse(), |
|
7396 +#elif (PERL_BCDVERSION == 0x5003022) |
|
7397 + start_subparse(0), |
|
7398 +#else /* 5.003_23 onwards */ |
|
7399 + start_subparse(FALSE, 0), |
|
7400 +#endif |
|
7401 + |
|
7402 + newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)), |
|
7403 + newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ |
|
7404 + newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) |
|
7405 + ); |
|
7406 + |
|
7407 + PL_hints = oldhints; |
|
7408 + PL_curcop->cop_stash = old_cop_stash; |
|
7409 + PL_curstash = old_curstash; |
|
7410 + PL_curcop->cop_line = oldline; |
|
7411 +} |
|
7412 +#endif |
|
7413 +#endif |
|
7414 + |
|
7415 +/* |
|
7416 + * Boilerplate macros for initializing and accessing interpreter-local |
|
7417 + * data from C. All statics in extensions should be reworked to use |
|
7418 + * this, if you want to make the extension thread-safe. See ext/re/re.xs |
|
7419 + * for an example of the use of these macros. |
|
7420 + * |
|
7421 + * Code that uses these macros is responsible for the following: |
|
7422 + * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" |
|
7423 + * 2. Declare a typedef named my_cxt_t that is a structure that contains |
|
7424 + * all the data that needs to be interpreter-local. |
|
7425 + * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. |
|
7426 + * 4. Use the MY_CXT_INIT macro such that it is called exactly once |
|
7427 + * (typically put in the BOOT: section). |
|
7428 + * 5. Use the members of the my_cxt_t structure everywhere as |
|
7429 + * MY_CXT.member. |
|
7430 + * 6. Use the dMY_CXT macro (a declaration) in all the functions that |
|
7431 + * access MY_CXT. |
|
7432 + */ |
|
7433 + |
|
7434 +#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ |
|
7435 + defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) |
|
7436 + |
|
7437 +#ifndef START_MY_CXT |
|
7438 + |
|
7439 +/* This must appear in all extensions that define a my_cxt_t structure, |
|
7440 + * right after the definition (i.e. at file scope). The non-threads |
|
7441 + * case below uses it to declare the data as static. */ |
|
7442 +#define START_MY_CXT |
|
7443 + |
|
7444 +#if (PERL_BCDVERSION < 0x5004068) |
|
7445 +/* Fetches the SV that keeps the per-interpreter data. */ |
|
7446 +#define dMY_CXT_SV \ |
|
7447 + SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) |
|
7448 +#else /* >= perl5.004_68 */ |
|
7449 +#define dMY_CXT_SV \ |
|
7450 + SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ |
|
7451 + sizeof(MY_CXT_KEY)-1, TRUE) |
|
7452 +#endif /* < perl5.004_68 */ |
|
7453 + |
|
7454 +/* This declaration should be used within all functions that use the |
|
7455 + * interpreter-local data. */ |
|
7456 +#define dMY_CXT \ |
|
7457 + dMY_CXT_SV; \ |
|
7458 + my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) |
|
7459 + |
|
7460 +/* Creates and zeroes the per-interpreter data. |
|
7461 + * (We allocate my_cxtp in a Perl SV so that it will be released when |
|
7462 + * the interpreter goes away.) */ |
|
7463 +#define MY_CXT_INIT \ |
|
7464 + dMY_CXT_SV; \ |
|
7465 + /* newSV() allocates one more than needed */ \ |
|
7466 + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ |
|
7467 + Zero(my_cxtp, 1, my_cxt_t); \ |
|
7468 + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) |
|
7469 + |
|
7470 +/* This macro must be used to access members of the my_cxt_t structure. |
|
7471 + * e.g. MYCXT.some_data */ |
|
7472 +#define MY_CXT (*my_cxtp) |
|
7473 + |
|
7474 +/* Judicious use of these macros can reduce the number of times dMY_CXT |
|
7475 + * is used. Use is similar to pTHX, aTHX etc. */ |
|
7476 +#define pMY_CXT my_cxt_t *my_cxtp |
|
7477 +#define pMY_CXT_ pMY_CXT, |
|
7478 +#define _pMY_CXT ,pMY_CXT |
|
7479 +#define aMY_CXT my_cxtp |
|
7480 +#define aMY_CXT_ aMY_CXT, |
|
7481 +#define _aMY_CXT ,aMY_CXT |
|
7482 + |
|
7483 +#endif /* START_MY_CXT */ |
|
7484 + |
|
7485 +#ifndef MY_CXT_CLONE |
|
7486 +/* Clones the per-interpreter data. */ |
|
7487 +#define MY_CXT_CLONE \ |
|
7488 + dMY_CXT_SV; \ |
|
7489 + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ |
|
7490 + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ |
|
7491 + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) |
|
7492 +#endif |
|
7493 + |
|
7494 +#else /* single interpreter */ |
|
7495 + |
|
7496 +#ifndef START_MY_CXT |
|
7497 + |
|
7498 +#define START_MY_CXT static my_cxt_t my_cxt; |
|
7499 +#define dMY_CXT_SV dNOOP |
|
7500 +#define dMY_CXT dNOOP |
|
7501 +#define MY_CXT_INIT NOOP |
|
7502 +#define MY_CXT my_cxt |
|
7503 + |
|
7504 +#define pMY_CXT void |
|
7505 +#define pMY_CXT_ |
|
7506 +#define _pMY_CXT |
|
7507 +#define aMY_CXT |
|
7508 +#define aMY_CXT_ |
|
7509 +#define _aMY_CXT |
|
7510 + |
|
7511 +#endif /* START_MY_CXT */ |
|
7512 + |
|
7513 +#ifndef MY_CXT_CLONE |
|
7514 +#define MY_CXT_CLONE NOOP |
|
7515 +#endif |
|
7516 + |
|
7517 +#endif |
|
7518 + |
|
7519 +#ifndef IVdf |
|
7520 +# if IVSIZE == LONGSIZE |
|
7521 +# define IVdf "ld" |
|
7522 +# define UVuf "lu" |
|
7523 +# define UVof "lo" |
|
7524 +# define UVxf "lx" |
|
7525 +# define UVXf "lX" |
|
7526 +# elif IVSIZE == INTSIZE |
|
7527 +# define IVdf "d" |
|
7528 +# define UVuf "u" |
|
7529 +# define UVof "o" |
|
7530 +# define UVxf "x" |
|
7531 +# define UVXf "X" |
|
7532 +# else |
|
7533 +# error "cannot define IV/UV formats" |
|
7534 +# endif |
|
7535 +#endif |
|
7536 + |
|
7537 +#ifndef NVef |
|
7538 +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ |
|
7539 + defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000) |
|
7540 + /* Not very likely, but let's try anyway. */ |
|
7541 +# define NVef PERL_PRIeldbl |
|
7542 +# define NVff PERL_PRIfldbl |
|
7543 +# define NVgf PERL_PRIgldbl |
|
7544 +# else |
|
7545 +# define NVef "e" |
|
7546 +# define NVff "f" |
|
7547 +# define NVgf "g" |
|
7548 +# endif |
|
7549 +#endif |
|
7550 + |
|
7551 +#ifndef SvREFCNT_inc |
|
7552 +# ifdef PERL_USE_GCC_BRACE_GROUPS |
|
7553 +# define SvREFCNT_inc(sv) \ |
|
7554 + ({ \ |
|
7555 + SV * const _sv = (SV*)(sv); \ |
|
7556 + if (_sv) \ |
|
7557 + (SvREFCNT(_sv))++; \ |
|
7558 + _sv; \ |
|
7559 + }) |
|
7560 +# else |
|
7561 +# define SvREFCNT_inc(sv) \ |
|
7562 + ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) |
|
7563 +# endif |
|
7564 +#endif |
|
7565 + |
|
7566 +#ifndef SvREFCNT_inc_simple |
|
7567 +# ifdef PERL_USE_GCC_BRACE_GROUPS |
|
7568 +# define SvREFCNT_inc_simple(sv) \ |
|
7569 + ({ \ |
|
7570 + if (sv) \ |
|
7571 + (SvREFCNT(sv))++; \ |
|
7572 + (SV *)(sv); \ |
|
7573 + }) |
|
7574 +# else |
|
7575 +# define SvREFCNT_inc_simple(sv) \ |
|
7576 + ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) |
|
7577 +# endif |
|
7578 +#endif |
|
7579 + |
|
7580 +#ifndef SvREFCNT_inc_NN |
|
7581 +# ifdef PERL_USE_GCC_BRACE_GROUPS |
|
7582 +# define SvREFCNT_inc_NN(sv) \ |
|
7583 + ({ \ |
|
7584 + SV * const _sv = (SV*)(sv); \ |
|
7585 + SvREFCNT(_sv)++; \ |
|
7586 + _sv; \ |
|
7587 + }) |
|
7588 +# else |
|
7589 +# define SvREFCNT_inc_NN(sv) \ |
|
7590 + (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) |
|
7591 +# endif |
|
7592 +#endif |
|
7593 + |
|
7594 +#ifndef SvREFCNT_inc_void |
|
7595 +# ifdef PERL_USE_GCC_BRACE_GROUPS |
|
7596 +# define SvREFCNT_inc_void(sv) \ |
|
7597 + ({ \ |
|
7598 + SV * const _sv = (SV*)(sv); \ |
|
7599 + if (_sv) \ |
|
7600 + (void)(SvREFCNT(_sv)++); \ |
|
7601 + }) |
|
7602 +# else |
|
7603 +# define SvREFCNT_inc_void(sv) \ |
|
7604 + (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) |
|
7605 +# endif |
|
7606 +#endif |
|
7607 +#ifndef SvREFCNT_inc_simple_void |
|
7608 +# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END |
|
7609 +#endif |
|
7610 + |
|
7611 +#ifndef SvREFCNT_inc_simple_NN |
|
7612 +# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) |
|
7613 +#endif |
|
7614 + |
|
7615 +#ifndef SvREFCNT_inc_void_NN |
|
7616 +# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) |
|
7617 +#endif |
|
7618 + |
|
7619 +#ifndef SvREFCNT_inc_simple_void_NN |
|
7620 +# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) |
|
7621 +#endif |
|
7622 + |
|
7623 +#ifndef newSV_type |
|
7624 + |
|
7625 +#if defined(NEED_newSV_type) |
|
7626 +static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t); |
|
7627 +static |
|
7628 +#else |
|
7629 +extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t); |
|
7630 +#endif |
|
7631 + |
|
7632 +#ifdef newSV_type |
|
7633 +# undef newSV_type |
|
7634 +#endif |
|
7635 +#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a) |
|
7636 +#define Perl_newSV_type DPPP_(my_newSV_type) |
|
7637 + |
|
7638 +#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL) |
|
7639 + |
|
7640 +SV* |
|
7641 +DPPP_(my_newSV_type)(pTHX_ svtype const t) |
|
7642 +{ |
|
7643 + SV* const sv = newSV(0); |
|
7644 + sv_upgrade(sv, t); |
|
7645 + return sv; |
|
7646 +} |
|
7647 + |
|
7648 +#endif |
|
7649 + |
|
7650 +#endif |
|
7651 + |
|
7652 +#if (PERL_BCDVERSION < 0x5006000) |
|
7653 +# define D_PPP_CONSTPV_ARG(x) ((char *) (x)) |
|
7654 +#else |
|
7655 +# define D_PPP_CONSTPV_ARG(x) (x) |
|
7656 +#endif |
|
7657 +#ifndef newSVpvn |
|
7658 +# define newSVpvn(data,len) ((data) \ |
|
7659 + ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ |
|
7660 + : newSV(0)) |
|
7661 +#endif |
|
7662 +#ifndef newSVpvn_utf8 |
|
7663 +# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) |
|
7664 +#endif |
|
7665 +#ifndef SVf_UTF8 |
|
7666 +# define SVf_UTF8 0 |
|
7667 +#endif |
|
7668 + |
|
7669 +#ifndef newSVpvn_flags |
|
7670 + |
|
7671 +#if defined(NEED_newSVpvn_flags) |
|
7672 +static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags); |
|
7673 +static |
|
7674 +#else |
|
7675 +extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags); |
|
7676 +#endif |
|
7677 + |
|
7678 +#ifdef newSVpvn_flags |
|
7679 +# undef newSVpvn_flags |
|
7680 +#endif |
|
7681 +#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c) |
|
7682 +#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags) |
|
7683 + |
|
7684 +#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL) |
|
7685 + |
|
7686 +SV * |
|
7687 +DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags) |
|
7688 +{ |
|
7689 + SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len); |
|
7690 + SvFLAGS(sv) |= (flags & SVf_UTF8); |
|
7691 + return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; |
|
7692 +} |
|
7693 + |
|
7694 +#endif |
|
7695 + |
|
7696 +#endif |
|
7697 + |
|
7698 +/* Backwards compatibility stuff... :-( */ |
|
7699 +#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen) |
|
7700 +# define NEED_sv_2pv_flags |
|
7701 +#endif |
|
7702 +#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL) |
|
7703 +# define NEED_sv_2pv_flags_GLOBAL |
|
7704 +#endif |
|
7705 + |
|
7706 +/* Hint: sv_2pv_nolen |
|
7707 + * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen(). |
|
7708 + */ |
|
7709 +#ifndef sv_2pv_nolen |
|
7710 +# define sv_2pv_nolen(sv) SvPV_nolen(sv) |
|
7711 +#endif |
|
7712 + |
|
7713 +#ifdef SvPVbyte |
|
7714 + |
|
7715 +/* Hint: SvPVbyte |
|
7716 + * Does not work in perl-5.6.1, ppport.h implements a version |
|
7717 + * borrowed from perl-5.7.3. |
|
7718 + */ |
|
7719 + |
|
7720 +#if (PERL_BCDVERSION < 0x5007000) |
|
7721 + |
|
7722 +#if defined(NEED_sv_2pvbyte) |
|
7723 +static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp); |
|
7724 +static |
|
7725 +#else |
|
7726 +extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp); |
|
7727 +#endif |
|
7728 + |
|
7729 +#ifdef sv_2pvbyte |
|
7730 +# undef sv_2pvbyte |
|
7731 +#endif |
|
7732 +#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b) |
|
7733 +#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) |
|
7734 + |
|
7735 +#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) |
|
7736 + |
|
7737 +char * |
|
7738 +DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp) |
|
7739 +{ |
|
7740 + sv_utf8_downgrade(sv,0); |
|
7741 + return SvPV(sv,*lp); |
|
7742 +} |
|
7743 + |
|
7744 +#endif |
|
7745 + |
|
7746 +/* Hint: sv_2pvbyte |
|
7747 + * Use the SvPVbyte() macro instead of sv_2pvbyte(). |
|
7748 + */ |
|
7749 + |
|
7750 +#undef SvPVbyte |
|
7751 + |
|
7752 +#define SvPVbyte(sv, lp) \ |
|
7753 + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ |
|
7754 + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) |
|
7755 + |
|
7756 +#endif |
|
7757 + |
|
7758 +#else |
|
7759 + |
|
7760 +# define SvPVbyte SvPV |
|
7761 +# define sv_2pvbyte sv_2pv |
|
7762 + |
|
7763 +#endif |
|
7764 +#ifndef sv_2pvbyte_nolen |
|
7765 +# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv) |
|
7766 +#endif |
|
7767 + |
|
7768 +/* Hint: sv_pvn |
|
7769 + * Always use the SvPV() macro instead of sv_pvn(). |
|
7770 + */ |
|
7771 + |
|
7772 +/* Hint: sv_pvn_force |
|
7773 + * Always use the SvPV_force() macro instead of sv_pvn_force(). |
|
7774 + */ |
|
7775 + |
|
7776 +/* If these are undefined, they're not handled by the core anyway */ |
|
7777 +#ifndef SV_IMMEDIATE_UNREF |
|
7778 +# define SV_IMMEDIATE_UNREF 0 |
|
7779 +#endif |
|
7780 + |
|
7781 +#ifndef SV_GMAGIC |
|
7782 +# define SV_GMAGIC 0 |
|
7783 +#endif |
|
7784 + |
|
7785 +#ifndef SV_COW_DROP_PV |
|
7786 +# define SV_COW_DROP_PV 0 |
|
7787 +#endif |
|
7788 + |
|
7789 +#ifndef SV_UTF8_NO_ENCODING |
|
7790 +# define SV_UTF8_NO_ENCODING 0 |
|
7791 +#endif |
|
7792 + |
|
7793 +#ifndef SV_NOSTEAL |
|
7794 +# define SV_NOSTEAL 0 |
|
7795 +#endif |
|
7796 + |
|
7797 +#ifndef SV_CONST_RETURN |
|
7798 +# define SV_CONST_RETURN 0 |
|
7799 +#endif |
|
7800 + |
|
7801 +#ifndef SV_MUTABLE_RETURN |
|
7802 +# define SV_MUTABLE_RETURN 0 |
|
7803 +#endif |
|
7804 + |
|
7805 +#ifndef SV_SMAGIC |
|
7806 +# define SV_SMAGIC 0 |
|
7807 +#endif |
|
7808 + |
|
7809 +#ifndef SV_HAS_TRAILING_NUL |
|
7810 +# define SV_HAS_TRAILING_NUL 0 |
|
7811 +#endif |
|
7812 + |
|
7813 +#ifndef SV_COW_SHARED_HASH_KEYS |
|
7814 +# define SV_COW_SHARED_HASH_KEYS 0 |
|
7815 +#endif |
|
7816 + |
|
7817 +#if (PERL_BCDVERSION < 0x5007002) |
|
7818 + |
|
7819 +#if defined(NEED_sv_2pv_flags) |
|
7820 +static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); |
|
7821 +static |
|
7822 +#else |
|
7823 +extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); |
|
7824 +#endif |
|
7825 + |
|
7826 +#ifdef sv_2pv_flags |
|
7827 +# undef sv_2pv_flags |
|
7828 +#endif |
|
7829 +#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c) |
|
7830 +#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags) |
|
7831 + |
|
7832 +#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL) |
|
7833 + |
|
7834 +char * |
|
7835 +DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags) |
|
7836 +{ |
|
7837 + STRLEN n_a = (STRLEN) flags; |
|
7838 + return sv_2pv(sv, lp ? lp : &n_a); |
|
7839 +} |
|
7840 + |
|
7841 +#endif |
|
7842 + |
|
7843 +#if defined(NEED_sv_pvn_force_flags) |
|
7844 +static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); |
|
7845 +static |
|
7846 +#else |
|
7847 +extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags); |
|
7848 +#endif |
|
7849 + |
|
7850 +#ifdef sv_pvn_force_flags |
|
7851 +# undef sv_pvn_force_flags |
|
7852 +#endif |
|
7853 +#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c) |
|
7854 +#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags) |
|
7855 + |
|
7856 +#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL) |
|
7857 + |
|
7858 +char * |
|
7859 +DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags) |
|
7860 +{ |
|
7861 + STRLEN n_a = (STRLEN) flags; |
|
7862 + return sv_pvn_force(sv, lp ? lp : &n_a); |
|
7863 +} |
|
7864 + |
|
7865 +#endif |
|
7866 + |
|
7867 +#endif |
|
7868 + |
|
7869 +#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) ) |
|
7870 +# define DPPP_SVPV_NOLEN_LP_ARG &PL_na |
|
7871 +#else |
|
7872 +# define DPPP_SVPV_NOLEN_LP_ARG 0 |
|
7873 +#endif |
|
7874 +#ifndef SvPV_const |
|
7875 +# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) |
|
7876 +#endif |
|
7877 + |
|
7878 +#ifndef SvPV_mutable |
|
7879 +# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) |
|
7880 +#endif |
|
7881 +#ifndef SvPV_flags |
|
7882 +# define SvPV_flags(sv, lp, flags) \ |
|
7883 + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ |
|
7884 + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) |
|
7885 +#endif |
|
7886 +#ifndef SvPV_flags_const |
|
7887 +# define SvPV_flags_const(sv, lp, flags) \ |
|
7888 + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ |
|
7889 + ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ |
|
7890 + (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) |
|
7891 +#endif |
|
7892 +#ifndef SvPV_flags_const_nolen |
|
7893 +# define SvPV_flags_const_nolen(sv, flags) \ |
|
7894 + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ |
|
7895 + ? SvPVX_const(sv) : \ |
|
7896 + (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN)) |
|
7897 +#endif |
|
7898 +#ifndef SvPV_flags_mutable |
|
7899 +# define SvPV_flags_mutable(sv, lp, flags) \ |
|
7900 + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ |
|
7901 + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ |
|
7902 + sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) |
|
7903 +#endif |
|
7904 +#ifndef SvPV_force |
|
7905 +# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) |
|
7906 +#endif |
|
7907 + |
|
7908 +#ifndef SvPV_force_nolen |
|
7909 +# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) |
|
7910 +#endif |
|
7911 + |
|
7912 +#ifndef SvPV_force_mutable |
|
7913 +# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC) |
|
7914 +#endif |
|
7915 + |
|
7916 +#ifndef SvPV_force_nomg |
|
7917 +# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) |
|
7918 +#endif |
|
7919 + |
|
7920 +#ifndef SvPV_force_nomg_nolen |
|
7921 +# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) |
|
7922 +#endif |
|
7923 +#ifndef SvPV_force_flags |
|
7924 +# define SvPV_force_flags(sv, lp, flags) \ |
|
7925 + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ |
|
7926 + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) |
|
7927 +#endif |
|
7928 +#ifndef SvPV_force_flags_nolen |
|
7929 +# define SvPV_force_flags_nolen(sv, flags) \ |
|
7930 + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ |
|
7931 + ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags)) |
|
7932 +#endif |
|
7933 +#ifndef SvPV_force_flags_mutable |
|
7934 +# define SvPV_force_flags_mutable(sv, lp, flags) \ |
|
7935 + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ |
|
7936 + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ |
|
7937 + : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) |
|
7938 +#endif |
|
7939 +#ifndef SvPV_nolen |
|
7940 +# define SvPV_nolen(sv) \ |
|
7941 + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ |
|
7942 + ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC)) |
|
7943 +#endif |
|
7944 +#ifndef SvPV_nolen_const |
|
7945 +# define SvPV_nolen_const(sv) \ |
|
7946 + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ |
|
7947 + ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN)) |
|
7948 +#endif |
|
7949 +#ifndef SvPV_nomg |
|
7950 +# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) |
|
7951 +#endif |
|
7952 + |
|
7953 +#ifndef SvPV_nomg_const |
|
7954 +# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) |
|
7955 +#endif |
|
7956 + |
|
7957 +#ifndef SvPV_nomg_const_nolen |
|
7958 +# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) |
|
7959 +#endif |
|
7960 + |
|
7961 +#ifndef SvPV_nomg_nolen |
|
7962 +# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ |
|
7963 + ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0)) |
|
7964 +#endif |
|
7965 +#ifndef SvPV_renew |
|
7966 +# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \ |
|
7967 + SvPV_set((sv), (char *) saferealloc( \ |
|
7968 + (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \ |
|
7969 + } STMT_END |
|
7970 +#endif |
|
7971 +#ifndef SvMAGIC_set |
|
7972 +# define SvMAGIC_set(sv, val) \ |
|
7973 + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ |
|
7974 + (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END |
|
7975 +#endif |
|
7976 + |
|
7977 +#if (PERL_BCDVERSION < 0x5009003) |
|
7978 +#ifndef SvPVX_const |
|
7979 +# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) |
|
7980 +#endif |
|
7981 + |
|
7982 +#ifndef SvPVX_mutable |
|
7983 +# define SvPVX_mutable(sv) (0 + SvPVX(sv)) |
|
7984 +#endif |
|
7985 +#ifndef SvRV_set |
|
7986 +# define SvRV_set(sv, val) \ |
|
7987 + STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ |
|
7988 + (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END |
|
7989 +#endif |
|
7990 + |
|
7991 +#else |
|
7992 +#ifndef SvPVX_const |
|
7993 +# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) |
|
7994 +#endif |
|
7995 + |
|
7996 +#ifndef SvPVX_mutable |
|
7997 +# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) |
|
7998 +#endif |
|
7999 +#ifndef SvRV_set |
|
8000 +# define SvRV_set(sv, val) \ |
|
8001 + STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ |
|
8002 + ((sv)->sv_u.svu_rv = (val)); } STMT_END |
|
8003 +#endif |
|
8004 + |
|
8005 +#endif |
|
8006 +#ifndef SvSTASH_set |
|
8007 +# define SvSTASH_set(sv, val) \ |
|
8008 + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ |
|
8009 + (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END |
|
8010 +#endif |
|
8011 + |
|
8012 +#if (PERL_BCDVERSION < 0x5004000) |
|
8013 +#ifndef SvUV_set |
|
8014 +# define SvUV_set(sv, val) \ |
|
8015 + STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ |
|
8016 + (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END |
|
8017 +#endif |
|
8018 + |
|
8019 +#else |
|
8020 +#ifndef SvUV_set |
|
8021 +# define SvUV_set(sv, val) \ |
|
8022 + STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ |
|
8023 + (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END |
|
8024 +#endif |
|
8025 + |
|
8026 +#endif |
|
8027 + |
|
8028 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf) |
|
8029 +#if defined(NEED_vnewSVpvf) |
|
8030 +static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); |
|
8031 +static |
|
8032 +#else |
|
8033 +extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); |
|
8034 +#endif |
|
8035 + |
|
8036 +#ifdef vnewSVpvf |
|
8037 +# undef vnewSVpvf |
|
8038 +#endif |
|
8039 +#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b) |
|
8040 +#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) |
|
8041 + |
|
8042 +#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) |
|
8043 + |
|
8044 +SV * |
|
8045 +DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) |
|
8046 +{ |
|
8047 + register SV *sv = newSV(0); |
|
8048 + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); |
|
8049 + return sv; |
|
8050 +} |
|
8051 + |
|
8052 +#endif |
|
8053 +#endif |
|
8054 + |
|
8055 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf) |
|
8056 +# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) |
|
8057 +#endif |
|
8058 + |
|
8059 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf) |
|
8060 +# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) |
|
8061 +#endif |
|
8062 + |
|
8063 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg) |
|
8064 +#if defined(NEED_sv_catpvf_mg) |
|
8065 +static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); |
|
8066 +static |
|
8067 +#else |
|
8068 +extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); |
|
8069 +#endif |
|
8070 + |
|
8071 +#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) |
|
8072 + |
|
8073 +#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) |
|
8074 + |
|
8075 +void |
|
8076 +DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) |
|
8077 +{ |
|
8078 + va_list args; |
|
8079 + va_start(args, pat); |
|
8080 + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); |
|
8081 + SvSETMAGIC(sv); |
|
8082 + va_end(args); |
|
8083 +} |
|
8084 + |
|
8085 +#endif |
|
8086 +#endif |
|
8087 + |
|
8088 +#ifdef PERL_IMPLICIT_CONTEXT |
|
8089 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext) |
|
8090 +#if defined(NEED_sv_catpvf_mg_nocontext) |
|
8091 +static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); |
|
8092 +static |
|
8093 +#else |
|
8094 +extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); |
|
8095 +#endif |
|
8096 + |
|
8097 +#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) |
|
8098 +#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) |
|
8099 + |
|
8100 +#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) |
|
8101 + |
|
8102 +void |
|
8103 +DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) |
|
8104 +{ |
|
8105 + dTHX; |
|
8106 + va_list args; |
|
8107 + va_start(args, pat); |
|
8108 + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); |
|
8109 + SvSETMAGIC(sv); |
|
8110 + va_end(args); |
|
8111 +} |
|
8112 + |
|
8113 +#endif |
|
8114 +#endif |
|
8115 +#endif |
|
8116 + |
|
8117 +/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */ |
|
8118 +#ifndef sv_catpvf_mg |
|
8119 +# ifdef PERL_IMPLICIT_CONTEXT |
|
8120 +# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext |
|
8121 +# else |
|
8122 +# define sv_catpvf_mg Perl_sv_catpvf_mg |
|
8123 +# endif |
|
8124 +#endif |
|
8125 + |
|
8126 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg) |
|
8127 +# define sv_vcatpvf_mg(sv, pat, args) \ |
|
8128 + STMT_START { \ |
|
8129 + sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ |
|
8130 + SvSETMAGIC(sv); \ |
|
8131 + } STMT_END |
|
8132 +#endif |
|
8133 + |
|
8134 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg) |
|
8135 +#if defined(NEED_sv_setpvf_mg) |
|
8136 +static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); |
|
8137 +static |
|
8138 +#else |
|
8139 +extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); |
|
8140 +#endif |
|
8141 + |
|
8142 +#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) |
|
8143 + |
|
8144 +#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) |
|
8145 + |
|
8146 +void |
|
8147 +DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) |
|
8148 +{ |
|
8149 + va_list args; |
|
8150 + va_start(args, pat); |
|
8151 + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); |
|
8152 + SvSETMAGIC(sv); |
|
8153 + va_end(args); |
|
8154 +} |
|
8155 + |
|
8156 +#endif |
|
8157 +#endif |
|
8158 + |
|
8159 +#ifdef PERL_IMPLICIT_CONTEXT |
|
8160 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext) |
|
8161 +#if defined(NEED_sv_setpvf_mg_nocontext) |
|
8162 +static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); |
|
8163 +static |
|
8164 +#else |
|
8165 +extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); |
|
8166 +#endif |
|
8167 + |
|
8168 +#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) |
|
8169 +#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) |
|
8170 + |
|
8171 +#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) |
|
8172 + |
|
8173 +void |
|
8174 +DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) |
|
8175 +{ |
|
8176 + dTHX; |
|
8177 + va_list args; |
|
8178 + va_start(args, pat); |
|
8179 + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); |
|
8180 + SvSETMAGIC(sv); |
|
8181 + va_end(args); |
|
8182 +} |
|
8183 + |
|
8184 +#endif |
|
8185 +#endif |
|
8186 +#endif |
|
8187 + |
|
8188 +/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */ |
|
8189 +#ifndef sv_setpvf_mg |
|
8190 +# ifdef PERL_IMPLICIT_CONTEXT |
|
8191 +# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext |
|
8192 +# else |
|
8193 +# define sv_setpvf_mg Perl_sv_setpvf_mg |
|
8194 +# endif |
|
8195 +#endif |
|
8196 + |
|
8197 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg) |
|
8198 +# define sv_vsetpvf_mg(sv, pat, args) \ |
|
8199 + STMT_START { \ |
|
8200 + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ |
|
8201 + SvSETMAGIC(sv); \ |
|
8202 + } STMT_END |
|
8203 +#endif |
|
8204 + |
|
8205 +/* Hint: newSVpvn_share |
|
8206 + * The SVs created by this function only mimic the behaviour of |
|
8207 + * shared PVs without really being shared. Only use if you know |
|
8208 + * what you're doing. |
|
8209 + */ |
|
8210 + |
|
8211 +#ifndef newSVpvn_share |
|
8212 + |
|
8213 +#if defined(NEED_newSVpvn_share) |
|
8214 +static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash); |
|
8215 +static |
|
8216 +#else |
|
8217 +extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash); |
|
8218 +#endif |
|
8219 + |
|
8220 +#ifdef newSVpvn_share |
|
8221 +# undef newSVpvn_share |
|
8222 +#endif |
|
8223 +#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c) |
|
8224 +#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share) |
|
8225 + |
|
8226 +#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL) |
|
8227 + |
|
8228 +SV * |
|
8229 +DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash) |
|
8230 +{ |
|
8231 + SV *sv; |
|
8232 + if (len < 0) |
|
8233 + len = -len; |
|
8234 + if (!hash) |
|
8235 + PERL_HASH(hash, (char*) src, len); |
|
8236 + sv = newSVpvn((char *) src, len); |
|
8237 + sv_upgrade(sv, SVt_PVIV); |
|
8238 + SvIVX(sv) = hash; |
|
8239 + SvREADONLY_on(sv); |
|
8240 + SvPOK_on(sv); |
|
8241 + return sv; |
|
8242 +} |
|
8243 + |
|
8244 +#endif |
|
8245 + |
|
8246 +#endif |
|
8247 +#ifndef SvSHARED_HASH |
|
8248 +# define SvSHARED_HASH(sv) (0 + SvUVX(sv)) |
|
8249 +#endif |
|
8250 +#ifndef HvNAME_get |
|
8251 +# define HvNAME_get(hv) HvNAME(hv) |
|
8252 +#endif |
|
8253 +#ifndef HvNAMELEN_get |
|
8254 +# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0) |
|
8255 +#endif |
|
8256 +#ifndef GvSVn |
|
8257 +# define GvSVn(gv) GvSV(gv) |
|
8258 +#endif |
|
8259 + |
|
8260 +#ifndef isGV_with_GP |
|
8261 +# define isGV_with_GP(gv) isGV(gv) |
|
8262 +#endif |
|
8263 + |
|
8264 +#ifndef gv_fetchpvn_flags |
|
8265 +# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt) |
|
8266 +#endif |
|
8267 + |
|
8268 +#ifndef gv_fetchsv |
|
8269 +# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt) |
|
8270 +#endif |
|
8271 +#ifndef get_cvn_flags |
|
8272 +# define get_cvn_flags(name, namelen, flags) get_cv(name, flags) |
|
8273 +#endif |
|
8274 +#ifndef WARN_ALL |
|
8275 +# define WARN_ALL 0 |
|
8276 +#endif |
|
8277 + |
|
8278 +#ifndef WARN_CLOSURE |
|
8279 +# define WARN_CLOSURE 1 |
|
8280 +#endif |
|
8281 + |
|
8282 +#ifndef WARN_DEPRECATED |
|
8283 +# define WARN_DEPRECATED 2 |
|
8284 +#endif |
|
8285 + |
|
8286 +#ifndef WARN_EXITING |
|
8287 +# define WARN_EXITING 3 |
|
8288 +#endif |
|
8289 + |
|
8290 +#ifndef WARN_GLOB |
|
8291 +# define WARN_GLOB 4 |
|
8292 +#endif |
|
8293 + |
|
8294 +#ifndef WARN_IO |
|
8295 +# define WARN_IO 5 |
|
8296 +#endif |
|
8297 + |
|
8298 +#ifndef WARN_CLOSED |
|
8299 +# define WARN_CLOSED 6 |
|
8300 +#endif |
|
8301 + |
|
8302 +#ifndef WARN_EXEC |
|
8303 +# define WARN_EXEC 7 |
|
8304 +#endif |
|
8305 + |
|
8306 +#ifndef WARN_LAYER |
|
8307 +# define WARN_LAYER 8 |
|
8308 +#endif |
|
8309 + |
|
8310 +#ifndef WARN_NEWLINE |
|
8311 +# define WARN_NEWLINE 9 |
|
8312 +#endif |
|
8313 + |
|
8314 +#ifndef WARN_PIPE |
|
8315 +# define WARN_PIPE 10 |
|
8316 +#endif |
|
8317 + |
|
8318 +#ifndef WARN_UNOPENED |
|
8319 +# define WARN_UNOPENED 11 |
|
8320 +#endif |
|
8321 + |
|
8322 +#ifndef WARN_MISC |
|
8323 +# define WARN_MISC 12 |
|
8324 +#endif |
|
8325 + |
|
8326 +#ifndef WARN_NUMERIC |
|
8327 +# define WARN_NUMERIC 13 |
|
8328 +#endif |
|
8329 + |
|
8330 +#ifndef WARN_ONCE |
|
8331 +# define WARN_ONCE 14 |
|
8332 +#endif |
|
8333 + |
|
8334 +#ifndef WARN_OVERFLOW |
|
8335 +# define WARN_OVERFLOW 15 |
|
8336 +#endif |
|
8337 + |
|
8338 +#ifndef WARN_PACK |
|
8339 +# define WARN_PACK 16 |
|
8340 +#endif |
|
8341 + |
|
8342 +#ifndef WARN_PORTABLE |
|
8343 +# define WARN_PORTABLE 17 |
|
8344 +#endif |
|
8345 + |
|
8346 +#ifndef WARN_RECURSION |
|
8347 +# define WARN_RECURSION 18 |
|
8348 +#endif |
|
8349 + |
|
8350 +#ifndef WARN_REDEFINE |
|
8351 +# define WARN_REDEFINE 19 |
|
8352 +#endif |
|
8353 + |
|
8354 +#ifndef WARN_REGEXP |
|
8355 +# define WARN_REGEXP 20 |
|
8356 +#endif |
|
8357 + |
|
8358 +#ifndef WARN_SEVERE |
|
8359 +# define WARN_SEVERE 21 |
|
8360 +#endif |
|
8361 + |
|
8362 +#ifndef WARN_DEBUGGING |
|
8363 +# define WARN_DEBUGGING 22 |
|
8364 +#endif |
|
8365 + |
|
8366 +#ifndef WARN_INPLACE |
|
8367 +# define WARN_INPLACE 23 |
|
8368 +#endif |
|
8369 + |
|
8370 +#ifndef WARN_INTERNAL |
|
8371 +# define WARN_INTERNAL 24 |
|
8372 +#endif |
|
8373 + |
|
8374 +#ifndef WARN_MALLOC |
|
8375 +# define WARN_MALLOC 25 |
|
8376 +#endif |
|
8377 + |
|
8378 +#ifndef WARN_SIGNAL |
|
8379 +# define WARN_SIGNAL 26 |
|
8380 +#endif |
|
8381 + |
|
8382 +#ifndef WARN_SUBSTR |
|
8383 +# define WARN_SUBSTR 27 |
|
8384 +#endif |
|
8385 + |
|
8386 +#ifndef WARN_SYNTAX |
|
8387 +# define WARN_SYNTAX 28 |
|
8388 +#endif |
|
8389 + |
|
8390 +#ifndef WARN_AMBIGUOUS |
|
8391 +# define WARN_AMBIGUOUS 29 |
|
8392 +#endif |
|
8393 + |
|
8394 +#ifndef WARN_BAREWORD |
|
8395 +# define WARN_BAREWORD 30 |
|
8396 +#endif |
|
8397 + |
|
8398 +#ifndef WARN_DIGIT |
|
8399 +# define WARN_DIGIT 31 |
|
8400 +#endif |
|
8401 + |
|
8402 +#ifndef WARN_PARENTHESIS |
|
8403 +# define WARN_PARENTHESIS 32 |
|
8404 +#endif |
|
8405 + |
|
8406 +#ifndef WARN_PRECEDENCE |
|
8407 +# define WARN_PRECEDENCE 33 |
|
8408 +#endif |
|
8409 + |
|
8410 +#ifndef WARN_PRINTF |
|
8411 +# define WARN_PRINTF 34 |
|
8412 +#endif |
|
8413 + |
|
8414 +#ifndef WARN_PROTOTYPE |
|
8415 +# define WARN_PROTOTYPE 35 |
|
8416 +#endif |
|
8417 + |
|
8418 +#ifndef WARN_QW |
|
8419 +# define WARN_QW 36 |
|
8420 +#endif |
|
8421 + |
|
8422 +#ifndef WARN_RESERVED |
|
8423 +# define WARN_RESERVED 37 |
|
8424 +#endif |
|
8425 + |
|
8426 +#ifndef WARN_SEMICOLON |
|
8427 +# define WARN_SEMICOLON 38 |
|
8428 +#endif |
|
8429 + |
|
8430 +#ifndef WARN_TAINT |
|
8431 +# define WARN_TAINT 39 |
|
8432 +#endif |
|
8433 + |
|
8434 +#ifndef WARN_THREADS |
|
8435 +# define WARN_THREADS 40 |
|
8436 +#endif |
|
8437 + |
|
8438 +#ifndef WARN_UNINITIALIZED |
|
8439 +# define WARN_UNINITIALIZED 41 |
|
8440 +#endif |
|
8441 + |
|
8442 +#ifndef WARN_UNPACK |
|
8443 +# define WARN_UNPACK 42 |
|
8444 +#endif |
|
8445 + |
|
8446 +#ifndef WARN_UNTIE |
|
8447 +# define WARN_UNTIE 43 |
|
8448 +#endif |
|
8449 + |
|
8450 +#ifndef WARN_UTF8 |
|
8451 +# define WARN_UTF8 44 |
|
8452 +#endif |
|
8453 + |
|
8454 +#ifndef WARN_VOID |
|
8455 +# define WARN_VOID 45 |
|
8456 +#endif |
|
8457 + |
|
8458 +#ifndef WARN_ASSERTIONS |
|
8459 +# define WARN_ASSERTIONS 46 |
|
8460 +#endif |
|
8461 +#ifndef packWARN |
|
8462 +# define packWARN(a) (a) |
|
8463 +#endif |
|
8464 + |
|
8465 +#ifndef ckWARN |
|
8466 +# ifdef G_WARN_ON |
|
8467 +# define ckWARN(a) (PL_dowarn & G_WARN_ON) |
|
8468 +# else |
|
8469 +# define ckWARN(a) PL_dowarn |
|
8470 +# endif |
|
8471 +#endif |
|
8472 + |
|
8473 +#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner) |
|
8474 +#if defined(NEED_warner) |
|
8475 +static void DPPP_(my_warner)(U32 err, const char *pat, ...); |
|
8476 +static |
|
8477 +#else |
|
8478 +extern void DPPP_(my_warner)(U32 err, const char *pat, ...); |
|
8479 +#endif |
|
8480 + |
|
8481 +#define Perl_warner DPPP_(my_warner) |
|
8482 + |
|
8483 +#if defined(NEED_warner) || defined(NEED_warner_GLOBAL) |
|
8484 + |
|
8485 +void |
|
8486 +DPPP_(my_warner)(U32 err, const char *pat, ...) |
|
8487 +{ |
|
8488 + SV *sv; |
|
8489 + va_list args; |
|
8490 + |
|
8491 + PERL_UNUSED_ARG(err); |
|
8492 + |
|
8493 + va_start(args, pat); |
|
8494 + sv = vnewSVpvf(pat, &args); |
|
8495 + va_end(args); |
|
8496 + sv_2mortal(sv); |
|
8497 + warn("%s", SvPV_nolen(sv)); |
|
8498 +} |
|
8499 + |
|
8500 +#define warner Perl_warner |
|
8501 + |
|
8502 +#define Perl_warner_nocontext Perl_warner |
|
8503 + |
|
8504 +#endif |
|
8505 +#endif |
|
8506 + |
|
8507 +/* concatenating with "" ensures that only literal strings are accepted as argument |
|
8508 + * note that STR_WITH_LEN() can't be used as argument to macros or functions that |
|
8509 + * under some configurations might be macros |
|
8510 + */ |
|
8511 +#ifndef STR_WITH_LEN |
|
8512 +# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1) |
|
8513 +#endif |
|
8514 +#ifndef newSVpvs |
|
8515 +# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) |
|
8516 +#endif |
|
8517 + |
|
8518 +#ifndef newSVpvs_flags |
|
8519 +# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags) |
|
8520 +#endif |
|
8521 + |
|
8522 +#ifndef newSVpvs_share |
|
8523 +# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0) |
|
8524 +#endif |
|
8525 + |
|
8526 +#ifndef sv_catpvs |
|
8527 +# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) |
|
8528 +#endif |
|
8529 + |
|
8530 +#ifndef sv_setpvs |
|
8531 +# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) |
|
8532 +#endif |
|
8533 + |
|
8534 +#ifndef hv_fetchs |
|
8535 +# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) |
|
8536 +#endif |
|
8537 + |
|
8538 +#ifndef hv_stores |
|
8539 +# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) |
|
8540 +#endif |
|
8541 +#ifndef gv_fetchpvs |
|
8542 +# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt) |
|
8543 +#endif |
|
8544 + |
|
8545 +#ifndef gv_stashpvs |
|
8546 +# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags) |
|
8547 +#endif |
|
8548 +#ifndef get_cvs |
|
8549 +# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags) |
|
8550 +#endif |
|
8551 +#ifndef SvGETMAGIC |
|
8552 +# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END |
|
8553 +#endif |
|
8554 +#ifndef PERL_MAGIC_sv |
|
8555 +# define PERL_MAGIC_sv '\0' |
|
8556 +#endif |
|
8557 + |
|
8558 +#ifndef PERL_MAGIC_overload |
|
8559 +# define PERL_MAGIC_overload 'A' |
|
8560 +#endif |
|
8561 + |
|
8562 +#ifndef PERL_MAGIC_overload_elem |
|
8563 +# define PERL_MAGIC_overload_elem 'a' |
|
8564 +#endif |
|
8565 + |
|
8566 +#ifndef PERL_MAGIC_overload_table |
|
8567 +# define PERL_MAGIC_overload_table 'c' |
|
8568 +#endif |
|
8569 + |
|
8570 +#ifndef PERL_MAGIC_bm |
|
8571 +# define PERL_MAGIC_bm 'B' |
|
8572 +#endif |
|
8573 + |
|
8574 +#ifndef PERL_MAGIC_regdata |
|
8575 +# define PERL_MAGIC_regdata 'D' |
|
8576 +#endif |
|
8577 + |
|
8578 +#ifndef PERL_MAGIC_regdatum |
|
8579 +# define PERL_MAGIC_regdatum 'd' |
|
8580 +#endif |
|
8581 + |
|
8582 +#ifndef PERL_MAGIC_env |
|
8583 +# define PERL_MAGIC_env 'E' |
|
8584 +#endif |
|
8585 + |
|
8586 +#ifndef PERL_MAGIC_envelem |
|
8587 +# define PERL_MAGIC_envelem 'e' |
|
8588 +#endif |
|
8589 + |
|
8590 +#ifndef PERL_MAGIC_fm |
|
8591 +# define PERL_MAGIC_fm 'f' |
|
8592 +#endif |
|
8593 + |
|
8594 +#ifndef PERL_MAGIC_regex_global |
|
8595 +# define PERL_MAGIC_regex_global 'g' |
|
8596 +#endif |
|
8597 + |
|
8598 +#ifndef PERL_MAGIC_isa |
|
8599 +# define PERL_MAGIC_isa 'I' |
|
8600 +#endif |
|
8601 + |
|
8602 +#ifndef PERL_MAGIC_isaelem |
|
8603 +# define PERL_MAGIC_isaelem 'i' |
|
8604 +#endif |
|
8605 + |
|
8606 +#ifndef PERL_MAGIC_nkeys |
|
8607 +# define PERL_MAGIC_nkeys 'k' |
|
8608 +#endif |
|
8609 + |
|
8610 +#ifndef PERL_MAGIC_dbfile |
|
8611 +# define PERL_MAGIC_dbfile 'L' |
|
8612 +#endif |
|
8613 + |
|
8614 +#ifndef PERL_MAGIC_dbline |
|
8615 +# define PERL_MAGIC_dbline 'l' |
|
8616 +#endif |
|
8617 + |
|
8618 +#ifndef PERL_MAGIC_mutex |
|
8619 +# define PERL_MAGIC_mutex 'm' |
|
8620 +#endif |
|
8621 + |
|
8622 +#ifndef PERL_MAGIC_shared |
|
8623 +# define PERL_MAGIC_shared 'N' |
|
8624 +#endif |
|
8625 + |
|
8626 +#ifndef PERL_MAGIC_shared_scalar |
|
8627 +# define PERL_MAGIC_shared_scalar 'n' |
|
8628 +#endif |
|
8629 + |
|
8630 +#ifndef PERL_MAGIC_collxfrm |
|
8631 +# define PERL_MAGIC_collxfrm 'o' |
|
8632 +#endif |
|
8633 + |
|
8634 +#ifndef PERL_MAGIC_tied |
|
8635 +# define PERL_MAGIC_tied 'P' |
|
8636 +#endif |
|
8637 + |
|
8638 +#ifndef PERL_MAGIC_tiedelem |
|
8639 +# define PERL_MAGIC_tiedelem 'p' |
|
8640 +#endif |
|
8641 + |
|
8642 +#ifndef PERL_MAGIC_tiedscalar |
|
8643 +# define PERL_MAGIC_tiedscalar 'q' |
|
8644 +#endif |
|
8645 + |
|
8646 +#ifndef PERL_MAGIC_qr |
|
8647 +# define PERL_MAGIC_qr 'r' |
|
8648 +#endif |
|
8649 + |
|
8650 +#ifndef PERL_MAGIC_sig |
|
8651 +# define PERL_MAGIC_sig 'S' |
|
8652 +#endif |
|
8653 + |
|
8654 +#ifndef PERL_MAGIC_sigelem |
|
8655 +# define PERL_MAGIC_sigelem 's' |
|
8656 +#endif |
|
8657 + |
|
8658 +#ifndef PERL_MAGIC_taint |
|
8659 +# define PERL_MAGIC_taint 't' |
|
8660 +#endif |
|
8661 + |
|
8662 +#ifndef PERL_MAGIC_uvar |
|
8663 +# define PERL_MAGIC_uvar 'U' |
|
8664 +#endif |
|
8665 + |
|
8666 +#ifndef PERL_MAGIC_uvar_elem |
|
8667 +# define PERL_MAGIC_uvar_elem 'u' |
|
8668 +#endif |
|
8669 + |
|
8670 +#ifndef PERL_MAGIC_vstring |
|
8671 +# define PERL_MAGIC_vstring 'V' |
|
8672 +#endif |
|
8673 + |
|
8674 +#ifndef PERL_MAGIC_vec |
|
8675 +# define PERL_MAGIC_vec 'v' |
|
8676 +#endif |
|
8677 + |
|
8678 +#ifndef PERL_MAGIC_utf8 |
|
8679 +# define PERL_MAGIC_utf8 'w' |
|
8680 +#endif |
|
8681 + |
|
8682 +#ifndef PERL_MAGIC_substr |
|
8683 +# define PERL_MAGIC_substr 'x' |
|
8684 +#endif |
|
8685 + |
|
8686 +#ifndef PERL_MAGIC_defelem |
|
8687 +# define PERL_MAGIC_defelem 'y' |
|
8688 +#endif |
|
8689 + |
|
8690 +#ifndef PERL_MAGIC_glob |
|
8691 +# define PERL_MAGIC_glob '*' |
|
8692 +#endif |
|
8693 + |
|
8694 +#ifndef PERL_MAGIC_arylen |
|
8695 +# define PERL_MAGIC_arylen '#' |
|
8696 +#endif |
|
8697 + |
|
8698 +#ifndef PERL_MAGIC_pos |
|
8699 +# define PERL_MAGIC_pos '.' |
|
8700 +#endif |
|
8701 + |
|
8702 +#ifndef PERL_MAGIC_backref |
|
8703 +# define PERL_MAGIC_backref '<' |
|
8704 +#endif |
|
8705 + |
|
8706 +#ifndef PERL_MAGIC_ext |
|
8707 +# define PERL_MAGIC_ext '~' |
|
8708 +#endif |
|
8709 + |
|
8710 +/* That's the best we can do... */ |
|
8711 +#ifndef sv_catpvn_nomg |
|
8712 +# define sv_catpvn_nomg sv_catpvn |
|
8713 +#endif |
|
8714 + |
|
8715 +#ifndef sv_catsv_nomg |
|
8716 +# define sv_catsv_nomg sv_catsv |
|
8717 +#endif |
|
8718 + |
|
8719 +#ifndef sv_setsv_nomg |
|
8720 +# define sv_setsv_nomg sv_setsv |
|
8721 +#endif |
|
8722 + |
|
8723 +#ifndef sv_pvn_nomg |
|
8724 +# define sv_pvn_nomg sv_pvn |
|
8725 +#endif |
|
8726 + |
|
8727 +#ifndef SvIV_nomg |
|
8728 +# define SvIV_nomg SvIV |
|
8729 +#endif |
|
8730 + |
|
8731 +#ifndef SvUV_nomg |
|
8732 +# define SvUV_nomg SvUV |
|
8733 +#endif |
|
8734 + |
|
8735 +#ifndef sv_catpv_mg |
|
8736 +# define sv_catpv_mg(sv, ptr) \ |
|
8737 + STMT_START { \ |
|
8738 + SV *TeMpSv = sv; \ |
|
8739 + sv_catpv(TeMpSv,ptr); \ |
|
8740 + SvSETMAGIC(TeMpSv); \ |
|
8741 + } STMT_END |
|
8742 +#endif |
|
8743 + |
|
8744 +#ifndef sv_catpvn_mg |
|
8745 +# define sv_catpvn_mg(sv, ptr, len) \ |
|
8746 + STMT_START { \ |
|
8747 + SV *TeMpSv = sv; \ |
|
8748 + sv_catpvn(TeMpSv,ptr,len); \ |
|
8749 + SvSETMAGIC(TeMpSv); \ |
|
8750 + } STMT_END |
|
8751 +#endif |
|
8752 + |
|
8753 +#ifndef sv_catsv_mg |
|
8754 +# define sv_catsv_mg(dsv, ssv) \ |
|
8755 + STMT_START { \ |
|
8756 + SV *TeMpSv = dsv; \ |
|
8757 + sv_catsv(TeMpSv,ssv); \ |
|
8758 + SvSETMAGIC(TeMpSv); \ |
|
8759 + } STMT_END |
|
8760 +#endif |
|
8761 + |
|
8762 +#ifndef sv_setiv_mg |
|
8763 +# define sv_setiv_mg(sv, i) \ |
|
8764 + STMT_START { \ |
|
8765 + SV *TeMpSv = sv; \ |
|
8766 + sv_setiv(TeMpSv,i); \ |
|
8767 + SvSETMAGIC(TeMpSv); \ |
|
8768 + } STMT_END |
|
8769 +#endif |
|
8770 + |
|
8771 +#ifndef sv_setnv_mg |
|
8772 +# define sv_setnv_mg(sv, num) \ |
|
8773 + STMT_START { \ |
|
8774 + SV *TeMpSv = sv; \ |
|
8775 + sv_setnv(TeMpSv,num); \ |
|
8776 + SvSETMAGIC(TeMpSv); \ |
|
8777 + } STMT_END |
|
8778 +#endif |
|
8779 + |
|
8780 +#ifndef sv_setpv_mg |
|
8781 +# define sv_setpv_mg(sv, ptr) \ |
|
8782 + STMT_START { \ |
|
8783 + SV *TeMpSv = sv; \ |
|
8784 + sv_setpv(TeMpSv,ptr); \ |
|
8785 + SvSETMAGIC(TeMpSv); \ |
|
8786 + } STMT_END |
|
8787 +#endif |
|
8788 + |
|
8789 +#ifndef sv_setpvn_mg |
|
8790 +# define sv_setpvn_mg(sv, ptr, len) \ |
|
8791 + STMT_START { \ |
|
8792 + SV *TeMpSv = sv; \ |
|
8793 + sv_setpvn(TeMpSv,ptr,len); \ |
|
8794 + SvSETMAGIC(TeMpSv); \ |
|
8795 + } STMT_END |
|
8796 +#endif |
|
8797 + |
|
8798 +#ifndef sv_setsv_mg |
|
8799 +# define sv_setsv_mg(dsv, ssv) \ |
|
8800 + STMT_START { \ |
|
8801 + SV *TeMpSv = dsv; \ |
|
8802 + sv_setsv(TeMpSv,ssv); \ |
|
8803 + SvSETMAGIC(TeMpSv); \ |
|
8804 + } STMT_END |
|
8805 +#endif |
|
8806 + |
|
8807 +#ifndef sv_setuv_mg |
|
8808 +# define sv_setuv_mg(sv, i) \ |
|
8809 + STMT_START { \ |
|
8810 + SV *TeMpSv = sv; \ |
|
8811 + sv_setuv(TeMpSv,i); \ |
|
8812 + SvSETMAGIC(TeMpSv); \ |
|
8813 + } STMT_END |
|
8814 +#endif |
|
8815 + |
|
8816 +#ifndef sv_usepvn_mg |
|
8817 +# define sv_usepvn_mg(sv, ptr, len) \ |
|
8818 + STMT_START { \ |
|
8819 + SV *TeMpSv = sv; \ |
|
8820 + sv_usepvn(TeMpSv,ptr,len); \ |
|
8821 + SvSETMAGIC(TeMpSv); \ |
|
8822 + } STMT_END |
|
8823 +#endif |
|
8824 +#ifndef SvVSTRING_mg |
|
8825 +# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL) |
|
8826 +#endif |
|
8827 + |
|
8828 +/* Hint: sv_magic_portable |
|
8829 + * This is a compatibility function that is only available with |
|
8830 + * Devel::PPPort. It is NOT in the perl core. |
|
8831 + * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when |
|
8832 + * it is being passed a name pointer with namlen == 0. In that |
|
8833 + * case, perl 5.8.0 and later store the pointer, not a copy of it. |
|
8834 + * The compatibility can be provided back to perl 5.004. With |
|
8835 + * earlier versions, the code will not compile. |
|
8836 + */ |
|
8837 + |
|
8838 +#if (PERL_BCDVERSION < 0x5004000) |
|
8839 + |
|
8840 + /* code that uses sv_magic_portable will not compile */ |
|
8841 + |
|
8842 +#elif (PERL_BCDVERSION < 0x5008000) |
|
8843 + |
|
8844 +# define sv_magic_portable(sv, obj, how, name, namlen) \ |
|
8845 + STMT_START { \ |
|
8846 + SV *SvMp_sv = (sv); \ |
|
8847 + char *SvMp_name = (char *) (name); \ |
|
8848 + I32 SvMp_namlen = (namlen); \ |
|
8849 + if (SvMp_name && SvMp_namlen == 0) \ |
|
8850 + { \ |
|
8851 + MAGIC *mg; \ |
|
8852 + sv_magic(SvMp_sv, obj, how, 0, 0); \ |
|
8853 + mg = SvMAGIC(SvMp_sv); \ |
|
8854 + mg->mg_len = -42; /* XXX: this is the tricky part */ \ |
|
8855 + mg->mg_ptr = SvMp_name; \ |
|
8856 + } \ |
|
8857 + else \ |
|
8858 + { \ |
|
8859 + sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \ |
|
8860 + } \ |
|
8861 + } STMT_END |
|
8862 + |
|
8863 +#else |
|
8864 + |
|
8865 +# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e) |
|
8866 + |
|
8867 +#endif |
|
8868 + |
|
8869 +#ifdef USE_ITHREADS |
|
8870 +#ifndef CopFILE |
|
8871 +# define CopFILE(c) ((c)->cop_file) |
|
8872 +#endif |
|
8873 + |
|
8874 +#ifndef CopFILEGV |
|
8875 +# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) |
|
8876 +#endif |
|
8877 + |
|
8878 +#ifndef CopFILE_set |
|
8879 +# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) |
|
8880 +#endif |
|
8881 + |
|
8882 +#ifndef CopFILESV |
|
8883 +# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) |
|
8884 +#endif |
|
8885 + |
|
8886 +#ifndef CopFILEAV |
|
8887 +# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) |
|
8888 +#endif |
|
8889 + |
|
8890 +#ifndef CopSTASHPV |
|
8891 +# define CopSTASHPV(c) ((c)->cop_stashpv) |
|
8892 +#endif |
|
8893 + |
|
8894 +#ifndef CopSTASHPV_set |
|
8895 +# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) |
|
8896 +#endif |
|
8897 + |
|
8898 +#ifndef CopSTASH |
|
8899 +# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) |
|
8900 +#endif |
|
8901 + |
|
8902 +#ifndef CopSTASH_set |
|
8903 +# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) |
|
8904 +#endif |
|
8905 + |
|
8906 +#ifndef CopSTASH_eq |
|
8907 +# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ |
|
8908 + || (CopSTASHPV(c) && HvNAME(hv) \ |
|
8909 + && strEQ(CopSTASHPV(c), HvNAME(hv))))) |
|
8910 +#endif |
|
8911 + |
|
8912 +#else |
|
8913 +#ifndef CopFILEGV |
|
8914 +# define CopFILEGV(c) ((c)->cop_filegv) |
|
8915 +#endif |
|
8916 + |
|
8917 +#ifndef CopFILEGV_set |
|
8918 +# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) |
|
8919 +#endif |
|
8920 + |
|
8921 +#ifndef CopFILE_set |
|
8922 +# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) |
|
8923 +#endif |
|
8924 + |
|
8925 +#ifndef CopFILESV |
|
8926 +# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) |
|
8927 +#endif |
|
8928 + |
|
8929 +#ifndef CopFILEAV |
|
8930 +# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) |
|
8931 +#endif |
|
8932 + |
|
8933 +#ifndef CopFILE |
|
8934 +# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) |
|
8935 +#endif |
|
8936 + |
|
8937 +#ifndef CopSTASH |
|
8938 +# define CopSTASH(c) ((c)->cop_stash) |
|
8939 +#endif |
|
8940 + |
|
8941 +#ifndef CopSTASH_set |
|
8942 +# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) |
|
8943 +#endif |
|
8944 + |
|
8945 +#ifndef CopSTASHPV |
|
8946 +# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) |
|
8947 +#endif |
|
8948 + |
|
8949 +#ifndef CopSTASHPV_set |
|
8950 +# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) |
|
8951 +#endif |
|
8952 + |
|
8953 +#ifndef CopSTASH_eq |
|
8954 +# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) |
|
8955 +#endif |
|
8956 + |
|
8957 +#endif /* USE_ITHREADS */ |
|
8958 +#ifndef IN_PERL_COMPILETIME |
|
8959 +# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) |
|
8960 +#endif |
|
8961 + |
|
8962 +#ifndef IN_LOCALE_RUNTIME |
|
8963 +# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) |
|
8964 +#endif |
|
8965 + |
|
8966 +#ifndef IN_LOCALE_COMPILETIME |
|
8967 +# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) |
|
8968 +#endif |
|
8969 + |
|
8970 +#ifndef IN_LOCALE |
|
8971 +# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) |
|
8972 +#endif |
|
8973 +#ifndef IS_NUMBER_IN_UV |
|
8974 +# define IS_NUMBER_IN_UV 0x01 |
|
8975 +#endif |
|
8976 + |
|
8977 +#ifndef IS_NUMBER_GREATER_THAN_UV_MAX |
|
8978 +# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 |
|
8979 +#endif |
|
8980 + |
|
8981 +#ifndef IS_NUMBER_NOT_INT |
|
8982 +# define IS_NUMBER_NOT_INT 0x04 |
|
8983 +#endif |
|
8984 + |
|
8985 +#ifndef IS_NUMBER_NEG |
|
8986 +# define IS_NUMBER_NEG 0x08 |
|
8987 +#endif |
|
8988 + |
|
8989 +#ifndef IS_NUMBER_INFINITY |
|
8990 +# define IS_NUMBER_INFINITY 0x10 |
|
8991 +#endif |
|
8992 + |
|
8993 +#ifndef IS_NUMBER_NAN |
|
8994 +# define IS_NUMBER_NAN 0x20 |
|
8995 +#endif |
|
8996 +#ifndef GROK_NUMERIC_RADIX |
|
8997 +# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) |
|
8998 +#endif |
|
8999 +#ifndef PERL_SCAN_GREATER_THAN_UV_MAX |
|
9000 +# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 |
|
9001 +#endif |
|
9002 + |
|
9003 +#ifndef PERL_SCAN_SILENT_ILLDIGIT |
|
9004 +# define PERL_SCAN_SILENT_ILLDIGIT 0x04 |
|
9005 +#endif |
|
9006 + |
|
9007 +#ifndef PERL_SCAN_ALLOW_UNDERSCORES |
|
9008 +# define PERL_SCAN_ALLOW_UNDERSCORES 0x01 |
|
9009 +#endif |
|
9010 + |
|
9011 +#ifndef PERL_SCAN_DISALLOW_PREFIX |
|
9012 +# define PERL_SCAN_DISALLOW_PREFIX 0x02 |
|
9013 +#endif |
|
9014 + |
|
9015 +#ifndef grok_numeric_radix |
|
9016 +#if defined(NEED_grok_numeric_radix) |
|
9017 +static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); |
|
9018 +static |
|
9019 +#else |
|
9020 +extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); |
|
9021 +#endif |
|
9022 + |
|
9023 +#ifdef grok_numeric_radix |
|
9024 +# undef grok_numeric_radix |
|
9025 +#endif |
|
9026 +#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b) |
|
9027 +#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) |
|
9028 + |
|
9029 +#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) |
|
9030 +bool |
|
9031 +DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) |
|
9032 +{ |
|
9033 +#ifdef USE_LOCALE_NUMERIC |
|
9034 +#ifdef PL_numeric_radix_sv |
|
9035 + if (PL_numeric_radix_sv && IN_LOCALE) { |
|
9036 + STRLEN len; |
|
9037 + char* radix = SvPV(PL_numeric_radix_sv, len); |
|
9038 + if (*sp + len <= send && memEQ(*sp, radix, len)) { |
|
9039 + *sp += len; |
|
9040 + return TRUE; |
|
9041 + } |
|
9042 + } |
|
9043 +#else |
|
9044 + /* older perls don't have PL_numeric_radix_sv so the radix |
|
9045 + * must manually be requested from locale.h |
|
9046 + */ |
|
9047 +#include <locale.h> |
|
9048 + dTHR; /* needed for older threaded perls */ |
|
9049 + struct lconv *lc = localeconv(); |
|
9050 + char *radix = lc->decimal_point; |
|
9051 + if (radix && IN_LOCALE) { |
|
9052 + STRLEN len = strlen(radix); |
|
9053 + if (*sp + len <= send && memEQ(*sp, radix, len)) { |
|
9054 + *sp += len; |
|
9055 + return TRUE; |
|
9056 + } |
|
9057 + } |
|
9058 +#endif |
|
9059 +#endif /* USE_LOCALE_NUMERIC */ |
|
9060 + /* always try "." if numeric radix didn't match because |
|
9061 + * we may have data from different locales mixed */ |
|
9062 + if (*sp < send && **sp == '.') { |
|
9063 + ++*sp; |
|
9064 + return TRUE; |
|
9065 + } |
|
9066 + return FALSE; |
|
9067 +} |
|
9068 +#endif |
|
9069 +#endif |
|
9070 + |
|
9071 +#ifndef grok_number |
|
9072 +#if defined(NEED_grok_number) |
|
9073 +static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); |
|
9074 +static |
|
9075 +#else |
|
9076 +extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); |
|
9077 +#endif |
|
9078 + |
|
9079 +#ifdef grok_number |
|
9080 +# undef grok_number |
|
9081 +#endif |
|
9082 +#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c) |
|
9083 +#define Perl_grok_number DPPP_(my_grok_number) |
|
9084 + |
|
9085 +#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) |
|
9086 +int |
|
9087 +DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) |
|
9088 +{ |
|
9089 + const char *s = pv; |
|
9090 + const char *send = pv + len; |
|
9091 + const UV max_div_10 = UV_MAX / 10; |
|
9092 + const char max_mod_10 = UV_MAX % 10; |
|
9093 + int numtype = 0; |
|
9094 + int sawinf = 0; |
|
9095 + int sawnan = 0; |
|
9096 + |
|
9097 + while (s < send && isSPACE(*s)) |
|
9098 + s++; |
|
9099 + if (s == send) { |
|
9100 + return 0; |
|
9101 + } else if (*s == '-') { |
|
9102 + s++; |
|
9103 + numtype = IS_NUMBER_NEG; |
|
9104 + } |
|
9105 + else if (*s == '+') |
|
9106 + s++; |
|
9107 + |
|
9108 + if (s == send) |
|
9109 + return 0; |
|
9110 + |
|
9111 + /* next must be digit or the radix separator or beginning of infinity */ |
|
9112 + if (isDIGIT(*s)) { |
|
9113 + /* UVs are at least 32 bits, so the first 9 decimal digits cannot |
|
9114 + overflow. */ |
|
9115 + UV value = *s - '0'; |
|
9116 + /* This construction seems to be more optimiser friendly. |
|
9117 + (without it gcc does the isDIGIT test and the *s - '0' separately) |
|
9118 + With it gcc on arm is managing 6 instructions (6 cycles) per digit. |
|
9119 + In theory the optimiser could deduce how far to unroll the loop |
|
9120 + before checking for overflow. */ |
|
9121 + if (++s < send) { |
|
9122 + int digit = *s - '0'; |
|
9123 + if (digit >= 0 && digit <= 9) { |
|
9124 + value = value * 10 + digit; |
|
9125 + if (++s < send) { |
|
9126 + digit = *s - '0'; |
|
9127 + if (digit >= 0 && digit <= 9) { |
|
9128 + value = value * 10 + digit; |
|
9129 + if (++s < send) { |
|
9130 + digit = *s - '0'; |
|
9131 + if (digit >= 0 && digit <= 9) { |
|
9132 + value = value * 10 + digit; |
|
9133 + if (++s < send) { |
|
9134 + digit = *s - '0'; |
|
9135 + if (digit >= 0 && digit <= 9) { |
|
9136 + value = value * 10 + digit; |
|
9137 + if (++s < send) { |
|
9138 + digit = *s - '0'; |
|
9139 + if (digit >= 0 && digit <= 9) { |
|
9140 + value = value * 10 + digit; |
|
9141 + if (++s < send) { |
|
9142 + digit = *s - '0'; |
|
9143 + if (digit >= 0 && digit <= 9) { |
|
9144 + value = value * 10 + digit; |
|
9145 + if (++s < send) { |
|
9146 + digit = *s - '0'; |
|
9147 + if (digit >= 0 && digit <= 9) { |
|
9148 + value = value * 10 + digit; |
|
9149 + if (++s < send) { |
|
9150 + digit = *s - '0'; |
|
9151 + if (digit >= 0 && digit <= 9) { |
|
9152 + value = value * 10 + digit; |
|
9153 + if (++s < send) { |
|
9154 + /* Now got 9 digits, so need to check |
|
9155 + each time for overflow. */ |
|
9156 + digit = *s - '0'; |
|
9157 + while (digit >= 0 && digit <= 9 |
|
9158 + && (value < max_div_10 |
|
9159 + || (value == max_div_10 |
|
9160 + && digit <= max_mod_10))) { |
|
9161 + value = value * 10 + digit; |
|
9162 + if (++s < send) |
|
9163 + digit = *s - '0'; |
|
9164 + else |
|
9165 + break; |
|
9166 + } |
|
9167 + if (digit >= 0 && digit <= 9 |
|
9168 + && (s < send)) { |
|
9169 + /* value overflowed. |
|
9170 + skip the remaining digits, don't |
|
9171 + worry about setting *valuep. */ |
|
9172 + do { |
|
9173 + s++; |
|
9174 + } while (s < send && isDIGIT(*s)); |
|
9175 + numtype |= |
|
9176 + IS_NUMBER_GREATER_THAN_UV_MAX; |
|
9177 + goto skip_value; |
|
9178 + } |
|
9179 + } |
|
9180 + } |
|
9181 + } |
|
9182 + } |
|
9183 + } |
|
9184 + } |
|
9185 + } |
|
9186 + } |
|
9187 + } |
|
9188 + } |
|
9189 + } |
|
9190 + } |
|
9191 + } |
|
9192 + } |
|
9193 + } |
|
9194 + } |
|
9195 + } |
|
9196 + numtype |= IS_NUMBER_IN_UV; |
|
9197 + if (valuep) |
|
9198 + *valuep = value; |
|
9199 + |
|
9200 + skip_value: |
|
9201 + if (GROK_NUMERIC_RADIX(&s, send)) { |
|
9202 + numtype |= IS_NUMBER_NOT_INT; |
|
9203 + while (s < send && isDIGIT(*s)) /* optional digits after the radix */ |
|
9204 + s++; |
|
9205 + } |
|
9206 + } |
|
9207 + else if (GROK_NUMERIC_RADIX(&s, send)) { |
|
9208 + numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ |
|
9209 + /* no digits before the radix means we need digits after it */ |
|
9210 + if (s < send && isDIGIT(*s)) { |
|
9211 + do { |
|
9212 + s++; |
|
9213 + } while (s < send && isDIGIT(*s)); |
|
9214 + if (valuep) { |
|
9215 + /* integer approximation is valid - it's 0. */ |
|
9216 + *valuep = 0; |
|
9217 + } |
|
9218 + } |
|
9219 + else |
|
9220 + return 0; |
|
9221 + } else if (*s == 'I' || *s == 'i') { |
|
9222 + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; |
|
9223 + s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; |
|
9224 + s++; if (s < send && (*s == 'I' || *s == 'i')) { |
|
9225 + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; |
|
9226 + s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; |
|
9227 + s++; if (s == send || (*s != 'T' && *s != 't')) return 0; |
|
9228 + s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; |
|
9229 + s++; |
|
9230 + } |
|
9231 + sawinf = 1; |
|
9232 + } else if (*s == 'N' || *s == 'n') { |
|
9233 + /* XXX TODO: There are signaling NaNs and quiet NaNs. */ |
|
9234 + s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; |
|
9235 + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; |
|
9236 + s++; |
|
9237 + sawnan = 1; |
|
9238 + } else |
|
9239 + return 0; |
|
9240 + |
|
9241 + if (sawinf) { |
|
9242 + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ |
|
9243 + numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; |
|
9244 + } else if (sawnan) { |
|
9245 + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ |
|
9246 + numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; |
|
9247 + } else if (s < send) { |
|
9248 + /* we can have an optional exponent part */ |
|
9249 + if (*s == 'e' || *s == 'E') { |
|
9250 + /* The only flag we keep is sign. Blow away any "it's UV" */ |
|
9251 + numtype &= IS_NUMBER_NEG; |
|
9252 + numtype |= IS_NUMBER_NOT_INT; |
|
9253 + s++; |
|
9254 + if (s < send && (*s == '-' || *s == '+')) |
|
9255 + s++; |
|
9256 + if (s < send && isDIGIT(*s)) { |
|
9257 + do { |
|
9258 + s++; |
|
9259 + } while (s < send && isDIGIT(*s)); |
|
9260 + } |
|
9261 + else |
|
9262 + return 0; |
|
9263 + } |
|
9264 + } |
|
9265 + while (s < send && isSPACE(*s)) |
|
9266 + s++; |
|
9267 + if (s >= send) |
|
9268 + return numtype; |
|
9269 + if (len == 10 && memEQ(pv, "0 but true", 10)) { |
|
9270 + if (valuep) |
|
9271 + *valuep = 0; |
|
9272 + return IS_NUMBER_IN_UV; |
|
9273 + } |
|
9274 + return 0; |
|
9275 +} |
|
9276 +#endif |
|
9277 +#endif |
|
9278 + |
|
9279 +/* |
|
9280 + * The grok_* routines have been modified to use warn() instead of |
|
9281 + * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, |
|
9282 + * which is why the stack variable has been renamed to 'xdigit'. |
|
9283 + */ |
|
9284 + |
|
9285 +#ifndef grok_bin |
|
9286 +#if defined(NEED_grok_bin) |
|
9287 +static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); |
|
9288 +static |
|
9289 +#else |
|
9290 +extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); |
|
9291 +#endif |
|
9292 + |
|
9293 +#ifdef grok_bin |
|
9294 +# undef grok_bin |
|
9295 +#endif |
|
9296 +#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d) |
|
9297 +#define Perl_grok_bin DPPP_(my_grok_bin) |
|
9298 + |
|
9299 +#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) |
|
9300 +UV |
|
9301 +DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) |
|
9302 +{ |
|
9303 + const char *s = start; |
|
9304 + STRLEN len = *len_p; |
|
9305 + UV value = 0; |
|
9306 + NV value_nv = 0; |
|
9307 + |
|
9308 + const UV max_div_2 = UV_MAX / 2; |
|
9309 + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; |
|
9310 + bool overflowed = FALSE; |
|
9311 + |
|
9312 + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { |
|
9313 + /* strip off leading b or 0b. |
|
9314 + for compatibility silently suffer "b" and "0b" as valid binary |
|
9315 + numbers. */ |
|
9316 + if (len >= 1) { |
|
9317 + if (s[0] == 'b') { |
|
9318 + s++; |
|
9319 + len--; |
|
9320 + } |
|
9321 + else if (len >= 2 && s[0] == '0' && s[1] == 'b') { |
|
9322 + s+=2; |
|
9323 + len-=2; |
|
9324 + } |
|
9325 + } |
|
9326 + } |
|
9327 + |
|
9328 + for (; len-- && *s; s++) { |
|
9329 + char bit = *s; |
|
9330 + if (bit == '0' || bit == '1') { |
|
9331 + /* Write it in this wonky order with a goto to attempt to get the |
|
9332 + compiler to make the common case integer-only loop pretty tight. |
|
9333 + With gcc seems to be much straighter code than old scan_bin. */ |
|
9334 + redo: |
|
9335 + if (!overflowed) { |
|
9336 + if (value <= max_div_2) { |
|
9337 + value = (value << 1) | (bit - '0'); |
|
9338 + continue; |
|
9339 + } |
|
9340 + /* Bah. We're just overflowed. */ |
|
9341 + warn("Integer overflow in binary number"); |
|
9342 + overflowed = TRUE; |
|
9343 + value_nv = (NV) value; |
|
9344 + } |
|
9345 + value_nv *= 2.0; |
|
9346 + /* If an NV has not enough bits in its mantissa to |
|
9347 + * represent a UV this summing of small low-order numbers |
|
9348 + * is a waste of time (because the NV cannot preserve |
|
9349 + * the low-order bits anyway): we could just remember when |
|
9350 + * did we overflow and in the end just multiply value_nv by the |
|
9351 + * right amount. */ |
|
9352 + value_nv += (NV)(bit - '0'); |
|
9353 + continue; |
|
9354 + } |
|
9355 + if (bit == '_' && len && allow_underscores && (bit = s[1]) |
|
9356 + && (bit == '0' || bit == '1')) |
|
9357 + { |
|
9358 + --len; |
|
9359 + ++s; |
|
9360 + goto redo; |
|
9361 + } |
|
9362 + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) |
|
9363 + warn("Illegal binary digit '%c' ignored", *s); |
|
9364 + break; |
|
9365 + } |
|
9366 + |
|
9367 + if ( ( overflowed && value_nv > 4294967295.0) |
|
9368 +#if UVSIZE > 4 |
|
9369 + || (!overflowed && value > 0xffffffff ) |
|
9370 +#endif |
|
9371 + ) { |
|
9372 + warn("Binary number > 0b11111111111111111111111111111111 non-portable"); |
|
9373 + } |
|
9374 + *len_p = s - start; |
|
9375 + if (!overflowed) { |
|
9376 + *flags = 0; |
|
9377 + return value; |
|
9378 + } |
|
9379 + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; |
|
9380 + if (result) |
|
9381 + *result = value_nv; |
|
9382 + return UV_MAX; |
|
9383 +} |
|
9384 +#endif |
|
9385 +#endif |
|
9386 + |
|
9387 +#ifndef grok_hex |
|
9388 +#if defined(NEED_grok_hex) |
|
9389 +static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); |
|
9390 +static |
|
9391 +#else |
|
9392 +extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); |
|
9393 +#endif |
|
9394 + |
|
9395 +#ifdef grok_hex |
|
9396 +# undef grok_hex |
|
9397 +#endif |
|
9398 +#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d) |
|
9399 +#define Perl_grok_hex DPPP_(my_grok_hex) |
|
9400 + |
|
9401 +#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) |
|
9402 +UV |
|
9403 +DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) |
|
9404 +{ |
|
9405 + const char *s = start; |
|
9406 + STRLEN len = *len_p; |
|
9407 + UV value = 0; |
|
9408 + NV value_nv = 0; |
|
9409 + |
|
9410 + const UV max_div_16 = UV_MAX / 16; |
|
9411 + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; |
|
9412 + bool overflowed = FALSE; |
|
9413 + const char *xdigit; |
|
9414 + |
|
9415 + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { |
|
9416 + /* strip off leading x or 0x. |
|
9417 + for compatibility silently suffer "x" and "0x" as valid hex numbers. |
|
9418 + */ |
|
9419 + if (len >= 1) { |
|
9420 + if (s[0] == 'x') { |
|
9421 + s++; |
|
9422 + len--; |
|
9423 + } |
|
9424 + else if (len >= 2 && s[0] == '0' && s[1] == 'x') { |
|
9425 + s+=2; |
|
9426 + len-=2; |
|
9427 + } |
|
9428 + } |
|
9429 + } |
|
9430 + |
|
9431 + for (; len-- && *s; s++) { |
|
9432 + xdigit = strchr((char *) PL_hexdigit, *s); |
|
9433 + if (xdigit) { |
|
9434 + /* Write it in this wonky order with a goto to attempt to get the |
|
9435 + compiler to make the common case integer-only loop pretty tight. |
|
9436 + With gcc seems to be much straighter code than old scan_hex. */ |
|
9437 + redo: |
|
9438 + if (!overflowed) { |
|
9439 + if (value <= max_div_16) { |
|
9440 + value = (value << 4) | ((xdigit - PL_hexdigit) & 15); |
|
9441 + continue; |
|
9442 + } |
|
9443 + warn("Integer overflow in hexadecimal number"); |
|
9444 + overflowed = TRUE; |
|
9445 + value_nv = (NV) value; |
|
9446 + } |
|
9447 + value_nv *= 16.0; |
|
9448 + /* If an NV has not enough bits in its mantissa to |
|
9449 + * represent a UV this summing of small low-order numbers |
|
9450 + * is a waste of time (because the NV cannot preserve |
|
9451 + * the low-order bits anyway): we could just remember when |
|
9452 + * did we overflow and in the end just multiply value_nv by the |
|
9453 + * right amount of 16-tuples. */ |
|
9454 + value_nv += (NV)((xdigit - PL_hexdigit) & 15); |
|
9455 + continue; |
|
9456 + } |
|
9457 + if (*s == '_' && len && allow_underscores && s[1] |
|
9458 + && (xdigit = strchr((char *) PL_hexdigit, s[1]))) |
|
9459 + { |
|
9460 + --len; |
|
9461 + ++s; |
|
9462 + goto redo; |
|
9463 + } |
|
9464 + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) |
|
9465 + warn("Illegal hexadecimal digit '%c' ignored", *s); |
|
9466 + break; |
|
9467 + } |
|
9468 + |
|
9469 + if ( ( overflowed && value_nv > 4294967295.0) |
|
9470 +#if UVSIZE > 4 |
|
9471 + || (!overflowed && value > 0xffffffff ) |
|
9472 +#endif |
|
9473 + ) { |
|
9474 + warn("Hexadecimal number > 0xffffffff non-portable"); |
|
9475 + } |
|
9476 + *len_p = s - start; |
|
9477 + if (!overflowed) { |
|
9478 + *flags = 0; |
|
9479 + return value; |
|
9480 + } |
|
9481 + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; |
|
9482 + if (result) |
|
9483 + *result = value_nv; |
|
9484 + return UV_MAX; |
|
9485 +} |
|
9486 +#endif |
|
9487 +#endif |
|
9488 + |
|
9489 +#ifndef grok_oct |
|
9490 +#if defined(NEED_grok_oct) |
|
9491 +static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); |
|
9492 +static |
|
9493 +#else |
|
9494 +extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result); |
|
9495 +#endif |
|
9496 + |
|
9497 +#ifdef grok_oct |
|
9498 +# undef grok_oct |
|
9499 +#endif |
|
9500 +#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d) |
|
9501 +#define Perl_grok_oct DPPP_(my_grok_oct) |
|
9502 + |
|
9503 +#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) |
|
9504 +UV |
|
9505 +DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) |
|
9506 +{ |
|
9507 + const char *s = start; |
|
9508 + STRLEN len = *len_p; |
|
9509 + UV value = 0; |
|
9510 + NV value_nv = 0; |
|
9511 + |
|
9512 + const UV max_div_8 = UV_MAX / 8; |
|
9513 + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; |
|
9514 + bool overflowed = FALSE; |
|
9515 + |
|
9516 + for (; len-- && *s; s++) { |
|
9517 + /* gcc 2.95 optimiser not smart enough to figure that this subtraction |
|
9518 + out front allows slicker code. */ |
|
9519 + int digit = *s - '0'; |
|
9520 + if (digit >= 0 && digit <= 7) { |
|
9521 + /* Write it in this wonky order with a goto to attempt to get the |
|
9522 + compiler to make the common case integer-only loop pretty tight. |
|
9523 + */ |
|
9524 + redo: |
|
9525 + if (!overflowed) { |
|
9526 + if (value <= max_div_8) { |
|
9527 + value = (value << 3) | digit; |
|
9528 + continue; |
|
9529 + } |
|
9530 + /* Bah. We're just overflowed. */ |
|
9531 + warn("Integer overflow in octal number"); |
|
9532 + overflowed = TRUE; |
|
9533 + value_nv = (NV) value; |
|
9534 + } |
|
9535 + value_nv *= 8.0; |
|
9536 + /* If an NV has not enough bits in its mantissa to |
|
9537 + * represent a UV this summing of small low-order numbers |
|
9538 + * is a waste of time (because the NV cannot preserve |
|
9539 + * the low-order bits anyway): we could just remember when |
|
9540 + * did we overflow and in the end just multiply value_nv by the |
|
9541 + * right amount of 8-tuples. */ |
|
9542 + value_nv += (NV)digit; |
|
9543 + continue; |
|
9544 + } |
|
9545 + if (digit == ('_' - '0') && len && allow_underscores |
|
9546 + && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) |
|
9547 + { |
|
9548 + --len; |
|
9549 + ++s; |
|
9550 + goto redo; |
|
9551 + } |
|
9552 + /* Allow \octal to work the DWIM way (that is, stop scanning |
|
9553 + * as soon as non-octal characters are seen, complain only iff |
|
9554 + * someone seems to want to use the digits eight and nine). */ |
|
9555 + if (digit == 8 || digit == 9) { |
|
9556 + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) |
|
9557 + warn("Illegal octal digit '%c' ignored", *s); |
|
9558 + } |
|
9559 + break; |
|
9560 + } |
|
9561 + |
|
9562 + if ( ( overflowed && value_nv > 4294967295.0) |
|
9563 +#if UVSIZE > 4 |
|
9564 + || (!overflowed && value > 0xffffffff ) |
|
9565 +#endif |
|
9566 + ) { |
|
9567 + warn("Octal number > 037777777777 non-portable"); |
|
9568 + } |
|
9569 + *len_p = s - start; |
|
9570 + if (!overflowed) { |
|
9571 + *flags = 0; |
|
9572 + return value; |
|
9573 + } |
|
9574 + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; |
|
9575 + if (result) |
|
9576 + *result = value_nv; |
|
9577 + return UV_MAX; |
|
9578 +} |
|
9579 +#endif |
|
9580 +#endif |
|
9581 + |
|
9582 +#if !defined(my_snprintf) |
|
9583 +#if defined(NEED_my_snprintf) |
|
9584 +static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); |
|
9585 +static |
|
9586 +#else |
|
9587 +extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); |
|
9588 +#endif |
|
9589 + |
|
9590 +#define my_snprintf DPPP_(my_my_snprintf) |
|
9591 +#define Perl_my_snprintf DPPP_(my_my_snprintf) |
|
9592 + |
|
9593 +#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL) |
|
9594 + |
|
9595 +int |
|
9596 +DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...) |
|
9597 +{ |
|
9598 + dTHX; |
|
9599 + int retval; |
|
9600 + va_list ap; |
|
9601 + va_start(ap, format); |
|
9602 +#ifdef HAS_VSNPRINTF |
|
9603 + retval = vsnprintf(buffer, len, format, ap); |
|
9604 +#else |
|
9605 + retval = vsprintf(buffer, format, ap); |
|
9606 +#endif |
|
9607 + va_end(ap); |
|
9608 + if (retval < 0 || (len > 0 && (Size_t)retval >= len)) |
|
9609 + Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); |
|
9610 + return retval; |
|
9611 +} |
|
9612 + |
|
9613 +#endif |
|
9614 +#endif |
|
9615 + |
|
9616 +#if !defined(my_sprintf) |
|
9617 +#if defined(NEED_my_sprintf) |
|
9618 +static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...); |
|
9619 +static |
|
9620 +#else |
|
9621 +extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...); |
|
9622 +#endif |
|
9623 + |
|
9624 +#define my_sprintf DPPP_(my_my_sprintf) |
|
9625 +#define Perl_my_sprintf DPPP_(my_my_sprintf) |
|
9626 + |
|
9627 +#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL) |
|
9628 + |
|
9629 +int |
|
9630 +DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...) |
|
9631 +{ |
|
9632 + va_list args; |
|
9633 + va_start(args, pat); |
|
9634 + vsprintf(buffer, pat, args); |
|
9635 + va_end(args); |
|
9636 + return strlen(buffer); |
|
9637 +} |
|
9638 + |
|
9639 +#endif |
|
9640 +#endif |
|
9641 + |
|
9642 +#ifdef NO_XSLOCKS |
|
9643 +# ifdef dJMPENV |
|
9644 +# define dXCPT dJMPENV; int rEtV = 0 |
|
9645 +# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) |
|
9646 +# define XCPT_TRY_END JMPENV_POP; |
|
9647 +# define XCPT_CATCH if (rEtV != 0) |
|
9648 +# define XCPT_RETHROW JMPENV_JUMP(rEtV) |
|
9649 +# else |
|
9650 +# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0 |
|
9651 +# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0) |
|
9652 +# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); |
|
9653 +# define XCPT_CATCH if (rEtV != 0) |
|
9654 +# define XCPT_RETHROW Siglongjmp(top_env, rEtV) |
|
9655 +# endif |
|
9656 +#endif |
|
9657 + |
|
9658 +#if !defined(my_strlcat) |
|
9659 +#if defined(NEED_my_strlcat) |
|
9660 +static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size); |
|
9661 +static |
|
9662 +#else |
|
9663 +extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size); |
|
9664 +#endif |
|
9665 + |
|
9666 +#define my_strlcat DPPP_(my_my_strlcat) |
|
9667 +#define Perl_my_strlcat DPPP_(my_my_strlcat) |
|
9668 + |
|
9669 +#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL) |
|
9670 + |
|
9671 +Size_t |
|
9672 +DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size) |
|
9673 +{ |
|
9674 + Size_t used, length, copy; |
|
9675 + |
|
9676 + used = strlen(dst); |
|
9677 + length = strlen(src); |
|
9678 + if (size > 0 && used < size - 1) { |
|
9679 + copy = (length >= size - used) ? size - used - 1 : length; |
|
9680 + memcpy(dst + used, src, copy); |
|
9681 + dst[used + copy] = '\0'; |
|
9682 + } |
|
9683 + return used + length; |
|
9684 +} |
|
9685 +#endif |
|
9686 +#endif |
|
9687 + |
|
9688 +#if !defined(my_strlcpy) |
|
9689 +#if defined(NEED_my_strlcpy) |
|
9690 +static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size); |
|
9691 +static |
|
9692 +#else |
|
9693 +extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size); |
|
9694 +#endif |
|
9695 + |
|
9696 +#define my_strlcpy DPPP_(my_my_strlcpy) |
|
9697 +#define Perl_my_strlcpy DPPP_(my_my_strlcpy) |
|
9698 + |
|
9699 +#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL) |
|
9700 + |
|
9701 +Size_t |
|
9702 +DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size) |
|
9703 +{ |
|
9704 + Size_t length, copy; |
|
9705 + |
|
9706 + length = strlen(src); |
|
9707 + if (size > 0) { |
|
9708 + copy = (length >= size) ? size - 1 : length; |
|
9709 + memcpy(dst, src, copy); |
|
9710 + dst[copy] = '\0'; |
|
9711 + } |
|
9712 + return length; |
|
9713 +} |
|
9714 + |
|
9715 +#endif |
|
9716 +#endif |
|
9717 +#ifndef PERL_PV_ESCAPE_QUOTE |
|
9718 +# define PERL_PV_ESCAPE_QUOTE 0x0001 |
|
9719 +#endif |
|
9720 + |
|
9721 +#ifndef PERL_PV_PRETTY_QUOTE |
|
9722 +# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE |
|
9723 +#endif |
|
9724 + |
|
9725 +#ifndef PERL_PV_PRETTY_ELLIPSES |
|
9726 +# define PERL_PV_PRETTY_ELLIPSES 0x0002 |
|
9727 +#endif |
|
9728 + |
|
9729 +#ifndef PERL_PV_PRETTY_LTGT |
|
9730 +# define PERL_PV_PRETTY_LTGT 0x0004 |
|
9731 +#endif |
|
9732 + |
|
9733 +#ifndef PERL_PV_ESCAPE_FIRSTCHAR |
|
9734 +# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 |
|
9735 +#endif |
|
9736 + |
|
9737 +#ifndef PERL_PV_ESCAPE_UNI |
|
9738 +# define PERL_PV_ESCAPE_UNI 0x0100 |
|
9739 +#endif |
|
9740 + |
|
9741 +#ifndef PERL_PV_ESCAPE_UNI_DETECT |
|
9742 +# define PERL_PV_ESCAPE_UNI_DETECT 0x0200 |
|
9743 +#endif |
|
9744 + |
|
9745 +#ifndef PERL_PV_ESCAPE_ALL |
|
9746 +# define PERL_PV_ESCAPE_ALL 0x1000 |
|
9747 +#endif |
|
9748 + |
|
9749 +#ifndef PERL_PV_ESCAPE_NOBACKSLASH |
|
9750 +# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000 |
|
9751 +#endif |
|
9752 + |
|
9753 +#ifndef PERL_PV_ESCAPE_NOCLEAR |
|
9754 +# define PERL_PV_ESCAPE_NOCLEAR 0x4000 |
|
9755 +#endif |
|
9756 + |
|
9757 +#ifndef PERL_PV_ESCAPE_RE |
|
9758 +# define PERL_PV_ESCAPE_RE 0x8000 |
|
9759 +#endif |
|
9760 + |
|
9761 +#ifndef PERL_PV_PRETTY_NOCLEAR |
|
9762 +# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR |
|
9763 +#endif |
|
9764 +#ifndef PERL_PV_PRETTY_DUMP |
|
9765 +# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE |
|
9766 +#endif |
|
9767 + |
|
9768 +#ifndef PERL_PV_PRETTY_REGPROP |
|
9769 +# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE |
|
9770 +#endif |
|
9771 + |
|
9772 +/* Hint: pv_escape |
|
9773 + * Note that unicode functionality is only backported to |
|
9774 + * those perl versions that support it. For older perl |
|
9775 + * versions, the implementation will fall back to bytes. |
|
9776 + */ |
|
9777 + |
|
9778 +#ifndef pv_escape |
|
9779 +#if defined(NEED_pv_escape) |
|
9780 +static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags); |
|
9781 +static |
|
9782 +#else |
|
9783 +extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags); |
|
9784 +#endif |
|
9785 + |
|
9786 +#ifdef pv_escape |
|
9787 +# undef pv_escape |
|
9788 +#endif |
|
9789 +#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f) |
|
9790 +#define Perl_pv_escape DPPP_(my_pv_escape) |
|
9791 + |
|
9792 +#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL) |
|
9793 + |
|
9794 +char * |
|
9795 +DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str, |
|
9796 + const STRLEN count, const STRLEN max, |
|
9797 + STRLEN * const escaped, const U32 flags) |
|
9798 +{ |
|
9799 + const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\'; |
|
9800 + const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc; |
|
9801 + char octbuf[32] = "%123456789ABCDF"; |
|
9802 + STRLEN wrote = 0; |
|
9803 + STRLEN chsize = 0; |
|
9804 + STRLEN readsize = 1; |
|
9805 +#if defined(is_utf8_string) && defined(utf8_to_uvchr) |
|
9806 + bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0; |
|
9807 +#endif |
|
9808 + const char *pv = str; |
|
9809 + const char * const end = pv + count; |
|
9810 + octbuf[0] = esc; |
|
9811 + |
|
9812 + if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) |
|
9813 + sv_setpvs(dsv, ""); |
|
9814 + |
|
9815 +#if defined(is_utf8_string) && defined(utf8_to_uvchr) |
|
9816 + if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) |
|
9817 + isuni = 1; |
|
9818 +#endif |
|
9819 + |
|
9820 + for (; pv < end && (!max || wrote < max) ; pv += readsize) { |
|
9821 + const UV u = |
|
9822 +#if defined(is_utf8_string) && defined(utf8_to_uvchr) |
|
9823 + isuni ? utf8_to_uvchr((U8*)pv, &readsize) : |
|
9824 +#endif |
|
9825 + (U8)*pv; |
|
9826 + const U8 c = (U8)u & 0xFF; |
|
9827 + |
|
9828 + if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) { |
|
9829 + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) |
|
9830 + chsize = my_snprintf(octbuf, sizeof octbuf, |
|
9831 + "%"UVxf, u); |
|
9832 + else |
|
9833 + chsize = my_snprintf(octbuf, sizeof octbuf, |
|
9834 + "%cx{%"UVxf"}", esc, u); |
|
9835 + } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { |
|
9836 + chsize = 1; |
|
9837 + } else { |
|
9838 + if (c == dq || c == esc || !isPRINT(c)) { |
|
9839 + chsize = 2; |
|
9840 + switch (c) { |
|
9841 + case '\\' : /* fallthrough */ |
|
9842 + case '%' : if (c == esc) |
|
9843 + octbuf[1] = esc; |
|
9844 + else |
|
9845 + chsize = 1; |
|
9846 + break; |
|
9847 + case '\v' : octbuf[1] = 'v'; break; |
|
9848 + case '\t' : octbuf[1] = 't'; break; |
|
9849 + case '\r' : octbuf[1] = 'r'; break; |
|
9850 + case '\n' : octbuf[1] = 'n'; break; |
|
9851 + case '\f' : octbuf[1] = 'f'; break; |
|
9852 + case '"' : if (dq == '"') |
|
9853 + octbuf[1] = '"'; |
|
9854 + else |
|
9855 + chsize = 1; |
|
9856 + break; |
|
9857 + default: chsize = my_snprintf(octbuf, sizeof octbuf, |
|
9858 + pv < end && isDIGIT((U8)*(pv+readsize)) |
|
9859 + ? "%c%03o" : "%c%o", esc, c); |
|
9860 + } |
|
9861 + } else { |
|
9862 + chsize = 1; |
|
9863 + } |
|
9864 + } |
|
9865 + if (max && wrote + chsize > max) { |
|
9866 + break; |
|
9867 + } else if (chsize > 1) { |
|
9868 + sv_catpvn(dsv, octbuf, chsize); |
|
9869 + wrote += chsize; |
|
9870 + } else { |
|
9871 + char tmp[2]; |
|
9872 + my_snprintf(tmp, sizeof tmp, "%c", c); |
|
9873 + sv_catpvn(dsv, tmp, 1); |
|
9874 + wrote++; |
|
9875 + } |
|
9876 + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) |
|
9877 + break; |
|
9878 + } |
|
9879 + if (escaped != NULL) |
|
9880 + *escaped= pv - str; |
|
9881 + return SvPVX(dsv); |
|
9882 +} |
|
9883 + |
|
9884 +#endif |
|
9885 +#endif |
|
9886 + |
|
9887 +#ifndef pv_pretty |
|
9888 +#if defined(NEED_pv_pretty) |
|
9889 +static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags); |
|
9890 +static |
|
9891 +#else |
|
9892 +extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags); |
|
9893 +#endif |
|
9894 + |
|
9895 +#ifdef pv_pretty |
|
9896 +# undef pv_pretty |
|
9897 +#endif |
|
9898 +#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g) |
|
9899 +#define Perl_pv_pretty DPPP_(my_pv_pretty) |
|
9900 + |
|
9901 +#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL) |
|
9902 + |
|
9903 +char * |
|
9904 +DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count, |
|
9905 + const STRLEN max, char const * const start_color, char const * const end_color, |
|
9906 + const U32 flags) |
|
9907 +{ |
|
9908 + const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%'; |
|
9909 + STRLEN escaped; |
|
9910 + |
|
9911 + if (!(flags & PERL_PV_PRETTY_NOCLEAR)) |
|
9912 + sv_setpvs(dsv, ""); |
|
9913 + |
|
9914 + if (dq == '"') |
|
9915 + sv_catpvs(dsv, "\""); |
|
9916 + else if (flags & PERL_PV_PRETTY_LTGT) |
|
9917 + sv_catpvs(dsv, "<"); |
|
9918 + |
|
9919 + if (start_color != NULL) |
|
9920 + sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color)); |
|
9921 + |
|
9922 + pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR); |
|
9923 + |
|
9924 + if (end_color != NULL) |
|
9925 + sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color)); |
|
9926 + |
|
9927 + if (dq == '"') |
|
9928 + sv_catpvs(dsv, "\""); |
|
9929 + else if (flags & PERL_PV_PRETTY_LTGT) |
|
9930 + sv_catpvs(dsv, ">"); |
|
9931 + |
|
9932 + if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count) |
|
9933 + sv_catpvs(dsv, "..."); |
|
9934 + |
|
9935 + return SvPVX(dsv); |
|
9936 +} |
|
9937 + |
|
9938 +#endif |
|
9939 +#endif |
|
9940 + |
|
9941 +#ifndef pv_display |
|
9942 +#if defined(NEED_pv_display) |
|
9943 +static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim); |
|
9944 +static |
|
9945 +#else |
|
9946 +extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim); |
|
9947 +#endif |
|
9948 + |
|
9949 +#ifdef pv_display |
|
9950 +# undef pv_display |
|
9951 +#endif |
|
9952 +#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e) |
|
9953 +#define Perl_pv_display DPPP_(my_pv_display) |
|
9954 + |
|
9955 +#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL) |
|
9956 + |
|
9957 +char * |
|
9958 +DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) |
|
9959 +{ |
|
9960 + pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP); |
|
9961 + if (len > cur && pv[cur] == '\0') |
|
9962 + sv_catpvs(dsv, "\\0"); |
|
9963 + return SvPVX(dsv); |
|
9964 +} |
|
9965 + |
|
9966 +#endif |
|
9967 +#endif |
|
9968 + |
|
9969 +#endif /* _P_P_PORTABILITY_H_ */ |
|
9970 + |
|
9971 +/* End of File ppport.h */ |
|
9972 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/bless_var_method.t perl-5.12.5_dumper/dist/Data-Dumper/t/bless_var_method.t |
|
9973 --- perl-5.12.5/dist/Data-Dumper/t/bless_var_method.t 1969-12-31 19:00:00.000000000 -0500 |
|
9974 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/bless_var_method.t 2014-10-09 15:06:36.175627384 -0400 |
|
9975 @@ -0,0 +1,86 @@ |
|
9976 +#!./perl -w |
|
9977 +# t/bless.t - Test Bless() |
|
9978 + |
|
9979 +BEGIN { |
|
9980 + if ($ENV{PERL_CORE}){ |
|
9981 + require Config; import Config; |
|
9982 + no warnings 'once'; |
|
9983 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
9984 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
9985 + exit 0; |
|
9986 + } |
|
9987 + } |
|
9988 +} |
|
9989 + |
|
9990 +use strict; |
|
9991 + |
|
9992 +use Data::Dumper; |
|
9993 +use Test::More tests => 8; |
|
9994 +use lib qw( ./t/lib ); |
|
9995 +use Testing qw( _dumptostr ); |
|
9996 + |
|
9997 +my %d = ( |
|
9998 + delta => 'd', |
|
9999 + beta => 'b', |
|
10000 + gamma => 'c', |
|
10001 + alpha => 'a', |
|
10002 +); |
|
10003 + |
|
10004 +run_tests_for_bless_var_method(); |
|
10005 +SKIP: { |
|
10006 + skip "XS version was unavailable, so we already ran with pure Perl", 4 |
|
10007 + if $Data::Dumper::Useperl; |
|
10008 + local $Data::Dumper::Useperl = 1; |
|
10009 + run_tests_for_bless_var_method(); |
|
10010 +} |
|
10011 + |
|
10012 +sub run_tests_for_bless_var_method { |
|
10013 + my ($obj, %dumps, $bless, $starting); |
|
10014 + |
|
10015 + note("\$Data::Dumper::Bless and Bless() set to true value"); |
|
10016 + |
|
10017 + $starting = $Data::Dumper::Bless; |
|
10018 + $bless = 1; |
|
10019 + local $Data::Dumper::Bless = $bless; |
|
10020 + $obj = Data::Dumper->new( [ \%d ] ); |
|
10021 + $dumps{'ddblessone'} = _dumptostr($obj); |
|
10022 + local $Data::Dumper::Bless = $starting; |
|
10023 + |
|
10024 + $obj = Data::Dumper->new( [ \%d ] ); |
|
10025 + $obj->Bless($bless); |
|
10026 + $dumps{'objblessone'} = _dumptostr($obj); |
|
10027 + |
|
10028 + is($dumps{'ddblessone'}, $dumps{'objblessone'}, |
|
10029 + "\$Data::Dumper::Bless = 1 and Bless(1) are equivalent"); |
|
10030 + %dumps = (); |
|
10031 + |
|
10032 + $bless = 0; |
|
10033 + local $Data::Dumper::Bless = $bless; |
|
10034 + $obj = Data::Dumper->new( [ \%d ] ); |
|
10035 + $dumps{'ddblesszero'} = _dumptostr($obj); |
|
10036 + local $Data::Dumper::Bless = $starting; |
|
10037 + |
|
10038 + $obj = Data::Dumper->new( [ \%d ] ); |
|
10039 + $obj->Bless($bless); |
|
10040 + $dumps{'objblesszero'} = _dumptostr($obj); |
|
10041 + |
|
10042 + is($dumps{'ddblesszero'}, $dumps{'objblesszero'}, |
|
10043 + "\$Data::Dumper::Bless = 0 and Bless(0) are equivalent"); |
|
10044 + |
|
10045 + $bless = undef; |
|
10046 + local $Data::Dumper::Bless = $bless; |
|
10047 + $obj = Data::Dumper->new( [ \%d ] ); |
|
10048 + $dumps{'ddblessundef'} = _dumptostr($obj); |
|
10049 + local $Data::Dumper::Bless = $starting; |
|
10050 + |
|
10051 + $obj = Data::Dumper->new( [ \%d ] ); |
|
10052 + $obj->Bless($bless); |
|
10053 + $dumps{'objblessundef'} = _dumptostr($obj); |
|
10054 + |
|
10055 + is($dumps{'ddblessundef'}, $dumps{'objblessundef'}, |
|
10056 + "\$Data::Dumper::Bless = undef and Bless(undef) are equivalent"); |
|
10057 + is($dumps{'ddblesszero'}, $dumps{'objblessundef'}, |
|
10058 + "\$Data::Dumper::Bless = undef and = 0 are equivalent"); |
|
10059 + %dumps = (); |
|
10060 +} |
|
10061 + |
|
10062 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/bless.t perl-5.12.5_dumper/dist/Data-Dumper/t/bless.t |
|
10063 --- perl-5.12.5/dist/Data-Dumper/t/bless.t 2012-11-03 19:25:59.000000000 -0400 |
|
10064 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/bless.t 2014-10-09 15:06:36.178706635 -0400 |
|
10065 @@ -5,16 +5,22 @@ |
|
10066 # Test::More 0.60 required because: |
|
10067 # - is_deeply(undef, $not_undef); now works. [rt.cpan.org 9441] |
|
10068 |
|
10069 -BEGIN { plan tests => 1+5*2; } |
|
10070 +BEGIN { plan tests => 1+2*5; } |
|
10071 |
|
10072 BEGIN { use_ok('Data::Dumper') }; |
|
10073 |
|
10074 # RT 39420: Data::Dumper fails to escape bless class name |
|
10075 |
|
10076 -# test under XS and pure Perl version |
|
10077 -foreach $Data::Dumper::Useperl (0, 1) { |
|
10078 +run_tests_for_bless(); |
|
10079 +SKIP: { |
|
10080 + skip "XS version was unavailable, so we already ran with pure Perl", 5 |
|
10081 + if $Data::Dumper::Useperl; |
|
10082 + local $Data::Dumper::Useperl = 1; |
|
10083 + run_tests_for_bless(); |
|
10084 +} |
|
10085 |
|
10086 -#diag("\$Data::Dumper::Useperl = $Data::Dumper::Useperl"); |
|
10087 +sub run_tests_for_bless { |
|
10088 +note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl"); |
|
10089 |
|
10090 { |
|
10091 my $t = bless( {}, q{a'b} ); |
|
10092 @@ -43,11 +49,14 @@ |
|
10093 |
|
10094 my $t = bless( qr//, 'foo'); |
|
10095 my $dt = Dumper($t); |
|
10096 -my $o = <<'PERL'; |
|
10097 -$VAR1 = bless( qr/(?-xism:)/, 'foo' ); |
|
10098 +my $o = ($] > 5.010 ? <<'PERL' : <<'PERL_LEGACY'); |
|
10099 +$VAR1 = bless( qr//, 'foo' ); |
|
10100 PERL |
|
10101 +$VAR1 = bless( qr/(?-xism:)/, 'foo' ); |
|
10102 +PERL_LEGACY |
|
10103 |
|
10104 is($dt, $o, "We can dump blessed qr//'s properly"); |
|
10105 |
|
10106 } |
|
10107 -} |
|
10108 + |
|
10109 +} # END sub run_tests_for_bless() |
|
10110 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/bugs.t perl-5.12.5_dumper/dist/Data-Dumper/t/bugs.t |
|
10111 --- perl-5.12.5/dist/Data-Dumper/t/bugs.t 2012-11-03 19:25:59.000000000 -0400 |
|
10112 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/bugs.t 2014-10-09 15:06:36.177067555 -0400 |
|
10113 @@ -1,6 +1,6 @@ |
|
10114 #!perl |
|
10115 # |
|
10116 -# regression tests for old bugs that don't fit other categories |
|
10117 +# regression tests for old bugs that do not fit other categories |
|
10118 |
|
10119 BEGIN { |
|
10120 require Config; import Config; |
|
10121 @@ -12,7 +12,7 @@ |
|
10122 } |
|
10123 |
|
10124 use strict; |
|
10125 -use Test::More tests => 5; |
|
10126 +use Test::More tests => 15; |
|
10127 use Data::Dumper; |
|
10128 |
|
10129 { |
|
10130 @@ -80,4 +80,68 @@ |
|
10131 doh('fixed'); |
|
10132 ok(1, "[perl #56766]"); # Still no core dump? We are fine. |
|
10133 |
|
10134 +SKIP: { |
|
10135 + skip "perl 5.10.1 crashes and DD cannot help it", 1 if $] < 5.0119999; |
|
10136 + # [perl #72332] Segfault on empty-string glob |
|
10137 + Data::Dumper->Dump([*{*STDERR{IO}}]); |
|
10138 + ok("ok", #ok |
|
10139 + "empty-string glob [perl #72332]"); |
|
10140 +} |
|
10141 + |
|
10142 +# writing out of bounds with malformed utf8 |
|
10143 +SKIP: { |
|
10144 + eval { require Encode }; |
|
10145 + skip("Encode not available", 1) if $@; |
|
10146 + local $^W=1; |
|
10147 + local $SIG{__WARN__} = sub {}; |
|
10148 + my $a="\x{fc}'" x 50; |
|
10149 + Encode::_utf8_on($a); |
|
10150 + Dumper $a; |
|
10151 + ok("ok", "no crash dumping malformed utf8 with the utf8 flag on"); |
|
10152 +} |
|
10153 + |
|
10154 +{ |
|
10155 + # We have to test reference equivalence, rather than actual output, as |
|
10156 + # Perl itself is buggy prior to 5.15.6. Output from DD should at least |
|
10157 + # evaluate to the same typeglob, regardless of perl bugs. |
|
10158 + my $tests = sub { |
|
10159 + my $VAR1; |
|
10160 + no strict 'refs'; |
|
10161 + is eval(Dumper \*{"foo::b\0ar"}), \*{"foo::b\0ar"}, |
|
10162 + 'GVs with nulls'; |
|
10163 + # There is a strange 5.6 bug that causes the eval to fail a supposed |
|
10164 + # strict vars test (involving $VAR1). Mentioning the glob beforehand |
|
10165 + # somehow makes it go away. |
|
10166 + () = \*{chr 256}; |
|
10167 + is eval Dumper(\*{chr 256})||die ($@), \*{chr 256}, |
|
10168 + 'GVs with UTF8 names (or not, depending on perl version)'; |
|
10169 + () = \*{"\0".chr 256}; # same bug |
|
10170 + is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256}, |
|
10171 + 'GVs with UTF8 and nulls'; |
|
10172 + }; |
|
10173 + SKIP: { |
|
10174 + skip "no XS", 3 if not defined &Data::Dumper::Dumpxs; |
|
10175 + local $Data::Dumper::Useperl = 0; |
|
10176 + &$tests; |
|
10177 + } |
|
10178 + local $Data::Dumper::Useperl = 1; |
|
10179 + &$tests; |
|
10180 +} |
|
10181 + |
|
10182 +{ |
|
10183 + # Test reference equivalence of dumping *{""}. |
|
10184 + my $tests = sub { |
|
10185 + my $VAR1; |
|
10186 + no strict 'refs'; |
|
10187 + is eval(Dumper \*{""}), \*{""}, 'dumping \*{""}'; |
|
10188 + }; |
|
10189 + SKIP: { |
|
10190 + skip "no XS", 1 if not defined &Data::Dumper::Dumpxs; |
|
10191 + local $Data::Dumper::Useperl = 0; |
|
10192 + &$tests; |
|
10193 + } |
|
10194 + local $Data::Dumper::Useperl = 1; |
|
10195 + &$tests; |
|
10196 +} |
|
10197 + |
|
10198 # EOF |
|
10199 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/deparse.t perl-5.12.5_dumper/dist/Data-Dumper/t/deparse.t |
|
10200 --- perl-5.12.5/dist/Data-Dumper/t/deparse.t 1969-12-31 19:00:00.000000000 -0500 |
|
10201 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/deparse.t 2014-10-09 15:06:36.176803024 -0400 |
|
10202 @@ -0,0 +1,80 @@ |
|
10203 +#!./perl -w |
|
10204 +# t/deparse.t - Test Deparse() |
|
10205 + |
|
10206 +BEGIN { |
|
10207 + if ($ENV{PERL_CORE}){ |
|
10208 + require Config; import Config; |
|
10209 + no warnings 'once'; |
|
10210 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
10211 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
10212 + exit 0; |
|
10213 + } |
|
10214 + } |
|
10215 +} |
|
10216 + |
|
10217 +use strict; |
|
10218 + |
|
10219 +use Data::Dumper; |
|
10220 +use Test::More tests => 8; |
|
10221 +use lib qw( ./t/lib ); |
|
10222 +use Testing qw( _dumptostr ); |
|
10223 + |
|
10224 +# Thanks to Arthur Axel "fREW" Schmidt: |
|
10225 +# http://search.cpan.org/~frew/Data-Dumper-Concise-2.020/lib/Data/Dumper/Concise.pm |
|
10226 + |
|
10227 +note("\$Data::Dumper::Deparse and Deparse()"); |
|
10228 + |
|
10229 +{ |
|
10230 + my ($obj, %dumps, $deparse, $starting); |
|
10231 + use strict; |
|
10232 + my $struct = { foo => "bar\nbaz", quux => sub { "fleem" } }; |
|
10233 + $obj = Data::Dumper->new( [ $struct ] ); |
|
10234 + $dumps{'noprev'} = _dumptostr($obj); |
|
10235 + |
|
10236 + $starting = $Data::Dumper::Deparse; |
|
10237 + local $Data::Dumper::Deparse = 0; |
|
10238 + $obj = Data::Dumper->new( [ $struct ] ); |
|
10239 + $dumps{'dddzero'} = _dumptostr($obj); |
|
10240 + local $Data::Dumper::Deparse = $starting; |
|
10241 + |
|
10242 + $obj = Data::Dumper->new( [ $struct ] ); |
|
10243 + $obj->Deparse(); |
|
10244 + $dumps{'objempty'} = _dumptostr($obj); |
|
10245 + |
|
10246 + $obj = Data::Dumper->new( [ $struct ] ); |
|
10247 + $obj->Deparse(0); |
|
10248 + $dumps{'objzero'} = _dumptostr($obj); |
|
10249 + |
|
10250 + is($dumps{'noprev'}, $dumps{'dddzero'}, |
|
10251 + "No previous setting and \$Data::Dumper::Deparse = 0 are equivalent"); |
|
10252 + is($dumps{'noprev'}, $dumps{'objempty'}, |
|
10253 + "No previous setting and Deparse() are equivalent"); |
|
10254 + is($dumps{'noprev'}, $dumps{'objzero'}, |
|
10255 + "No previous setting and Deparse(0) are equivalent"); |
|
10256 + |
|
10257 + local $Data::Dumper::Deparse = 1; |
|
10258 + $obj = Data::Dumper->new( [ $struct ] ); |
|
10259 + $dumps{'dddtrue'} = _dumptostr($obj); |
|
10260 + local $Data::Dumper::Deparse = $starting; |
|
10261 + |
|
10262 + $obj = Data::Dumper->new( [ $struct ] ); |
|
10263 + $obj->Deparse(1); |
|
10264 + $dumps{'objone'} = _dumptostr($obj); |
|
10265 + |
|
10266 + is($dumps{'dddtrue'}, $dumps{'objone'}, |
|
10267 + "\$Data::Dumper::Deparse = 1 and Deparse(1) are equivalent"); |
|
10268 + |
|
10269 + isnt($dumps{'dddzero'}, $dumps{'dddtrue'}, |
|
10270 + "\$Data::Dumper::Deparse = 0 differs from \$Data::Dumper::Deparse = 1"); |
|
10271 + |
|
10272 + like($dumps{'dddzero'}, |
|
10273 + qr/quux.*?sub.*?DUMMY/s, |
|
10274 + "\$Data::Dumper::Deparse = 0 reports DUMMY instead of deparsing coderef"); |
|
10275 + unlike($dumps{'dddtrue'}, |
|
10276 + qr/quux.*?sub.*?DUMMY/s, |
|
10277 + "\$Data::Dumper::Deparse = 1 does not report DUMMY"); |
|
10278 + like($dumps{'dddtrue'}, |
|
10279 + qr/quux.*?sub.*?use\sstrict.*?fleem/s, |
|
10280 + "\$Data::Dumper::Deparse = 1 deparses coderef"); |
|
10281 +} |
|
10282 + |
|
10283 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/dumper.t perl-5.12.5_dumper/dist/Data-Dumper/t/dumper.t |
|
10284 --- perl-5.12.5/dist/Data-Dumper/t/dumper.t 2012-11-03 19:25:59.000000000 -0400 |
|
10285 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/dumper.t 2014-10-09 15:06:36.180643046 -0400 |
|
10286 @@ -30,44 +30,44 @@ |
|
10287 my $t = eval $string; |
|
10288 ++$TNUM; |
|
10289 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g |
|
10290 - if ($WANT =~ /deadbeef/); |
|
10291 + if ($WANT =~ /deadbeef/); |
|
10292 if ($Is_ebcdic) { |
|
10293 - # these data need massaging with non ascii character sets |
|
10294 - # because of hashing order differences |
|
10295 - $WANT = join("\n",sort(split(/\n/,$WANT))); |
|
10296 - $WANT =~ s/\,$//mg; |
|
10297 - $t = join("\n",sort(split(/\n/,$t))); |
|
10298 - $t =~ s/\,$//mg; |
|
10299 + # these data need massaging with non ascii character sets |
|
10300 + # because of hashing order differences |
|
10301 + $WANT = join("\n",sort(split(/\n/,$WANT))); |
|
10302 + $WANT =~ s/\,$//mg; |
|
10303 + $t = join("\n",sort(split(/\n/,$t))); |
|
10304 + $t =~ s/\,$//mg; |
|
10305 } |
|
10306 $name = $name ? " - $name" : ''; |
|
10307 print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n" |
|
10308 - : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n"); |
|
10309 + : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n"); |
|
10310 |
|
10311 ++$TNUM; |
|
10312 if ($Is_ebcdic) { # EBCDIC. |
|
10313 - if ($TNUM == 311 || $TNUM == 314) { |
|
10314 - eval $string; |
|
10315 - } else { |
|
10316 - eval $t; |
|
10317 - } |
|
10318 + if ($TNUM == 311 || $TNUM == 314) { |
|
10319 + eval $string; |
|
10320 + } else { |
|
10321 + eval $t; |
|
10322 + } |
|
10323 } else { |
|
10324 - eval "$t"; |
|
10325 + eval "$t"; |
|
10326 } |
|
10327 print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n"; |
|
10328 |
|
10329 $t = eval $string; |
|
10330 ++$TNUM; |
|
10331 $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g |
|
10332 - if ($WANT =~ /deadbeef/); |
|
10333 + if ($WANT =~ /deadbeef/); |
|
10334 if ($Is_ebcdic) { |
|
10335 - # here too there are hashing order differences |
|
10336 - $WANT = join("\n",sort(split(/\n/,$WANT))); |
|
10337 - $WANT =~ s/\,$//mg; |
|
10338 - $t = join("\n",sort(split(/\n/,$t))); |
|
10339 - $t =~ s/\,$//mg; |
|
10340 + # here too there are hashing order differences |
|
10341 + $WANT = join("\n",sort(split(/\n/,$WANT))); |
|
10342 + $WANT =~ s/\,$//mg; |
|
10343 + $t = join("\n",sort(split(/\n/,$t))); |
|
10344 + $t =~ s/\,$//mg; |
|
10345 } |
|
10346 print( ($t eq $WANT and not $@) ? "ok $TNUM\n" |
|
10347 - : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); |
|
10348 + : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); |
|
10349 } |
|
10350 |
|
10351 sub SKIP_TEST { |
|
10352 @@ -83,11 +83,11 @@ |
|
10353 $Data::Dumper::Useperl = 1; |
|
10354 if (defined &Data::Dumper::Dumpxs) { |
|
10355 print "### XS extension loaded, will run XS tests\n"; |
|
10356 - $TMAX = 363; $XS = 1; |
|
10357 + $TMAX = 438; $XS = 1; |
|
10358 } |
|
10359 else { |
|
10360 print "### XS extensions not loaded, will NOT run XS tests\n"; |
|
10361 - $TMAX = 183; $XS = 0; |
|
10362 + $TMAX = 219; $XS = 0; |
|
10363 } |
|
10364 |
|
10365 print "1..$TMAX\n"; |
|
10366 @@ -122,8 +122,20 @@ |
|
10367 #$6 = $a->[1]{'c'}; |
|
10368 EOT |
|
10369 |
|
10370 -TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])); |
|
10371 -TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS; |
|
10372 +TEST (q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])), |
|
10373 + 'basic test with names: Dump()'); |
|
10374 +TEST (q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])), |
|
10375 + 'basic test with names: Dumpxs()') |
|
10376 + if $XS; |
|
10377 + |
|
10378 +SCOPE: { |
|
10379 + local $Data::Dumper::Sparseseen = 1; |
|
10380 + TEST (q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])), |
|
10381 + 'Sparseseen with names: Dump()'); |
|
10382 + TEST (q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])), |
|
10383 + 'Sparseseen with names: Dumpxs()') |
|
10384 + if $XS; |
|
10385 +} |
|
10386 |
|
10387 |
|
10388 ############# 7 |
|
10389 @@ -147,8 +159,20 @@ |
|
10390 EOT |
|
10391 |
|
10392 $Data::Dumper::Purity = 1; # fill in the holes for eval |
|
10393 -TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a |
|
10394 -TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS; |
|
10395 +TEST (q(Data::Dumper->Dump([$a, $b], [qw(*a b)])), |
|
10396 + 'Purity: basic test with dereferenced array: Dump()'); # print as @a |
|
10397 +TEST (q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])), |
|
10398 + 'Purity: basic test with dereferenced array: Dumpxs()') |
|
10399 + if $XS; |
|
10400 + |
|
10401 +SCOPE: { |
|
10402 + local $Data::Dumper::Sparseseen = 1; |
|
10403 + TEST (q(Data::Dumper->Dump([$a, $b], [qw(*a b)])), |
|
10404 + 'Purity: Sparseseen with dereferenced array: Dump()'); # print as @a |
|
10405 + TEST (q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])), |
|
10406 + 'Purity: Sparseseen with dereferenced array: Dumpxs()') |
|
10407 + if $XS; |
|
10408 +} |
|
10409 |
|
10410 ############# 13 |
|
10411 ## |
|
10412 @@ -170,8 +194,11 @@ |
|
10413 #$a = $b{'a'}; |
|
10414 EOT |
|
10415 |
|
10416 -TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b |
|
10417 -TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS; |
|
10418 +TEST (q(Data::Dumper->Dump([$b, $a], [qw(*b a)])), |
|
10419 + 'basic test with dereferenced hash: Dump()'); # print as %b |
|
10420 +TEST (q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])), |
|
10421 + 'basic test with dereferenced hash: Dumpxs()') |
|
10422 + if $XS; |
|
10423 |
|
10424 ############# 19 |
|
10425 ## |
|
10426 @@ -193,17 +220,19 @@ |
|
10427 EOT |
|
10428 |
|
10429 $Data::Dumper::Indent = 1; |
|
10430 -TEST q( |
|
10431 +TEST (q( |
|
10432 $d = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
10433 $d->Seen({'*c' => $c}); |
|
10434 $d->Dump; |
|
10435 - ); |
|
10436 + ), |
|
10437 + 'Indent: Seen: Dump()'); |
|
10438 if ($XS) { |
|
10439 - TEST q( |
|
10440 + TEST (q( |
|
10441 $d = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
10442 $d->Seen({'*c' => $c}); |
|
10443 $d->Dumpxs; |
|
10444 - ); |
|
10445 + ), |
|
10446 + 'Indent: Seen: Dumpxs()'); |
|
10447 } |
|
10448 |
|
10449 |
|
10450 @@ -230,9 +259,12 @@ |
|
10451 |
|
10452 $d->Indent(3); |
|
10453 $d->Purity(0)->Quotekeys(0); |
|
10454 -TEST q( $d->Reset; $d->Dump ); |
|
10455 +TEST (q( $d->Reset; $d->Dump ), |
|
10456 + 'Indent(3): Purity(0)->Quotekeys(0): Dump()'); |
|
10457 |
|
10458 -TEST q( $d->Reset; $d->Dumpxs ) if $XS; |
|
10459 +TEST (q( $d->Reset; $d->Dumpxs ), |
|
10460 + 'Indent(3): Purity(0)->Quotekeys(0): Dumpxs()') |
|
10461 + if $XS; |
|
10462 |
|
10463 ############# 31 |
|
10464 ## |
|
10465 @@ -253,8 +285,8 @@ |
|
10466 #$VAR1->[2] = $VAR1->[1]{'c'}; |
|
10467 EOT |
|
10468 |
|
10469 -TEST q(Dumper($a)); |
|
10470 -TEST q(Data::Dumper::DumperX($a)) if $XS; |
|
10471 +TEST (q(Dumper($a)), 'Dumper'); |
|
10472 +TEST (q(Data::Dumper::DumperX($a)), 'DumperX') if $XS; |
|
10473 |
|
10474 ############# 37 |
|
10475 ## |
|
10476 @@ -276,8 +308,11 @@ |
|
10477 local $Data::Dumper::Purity = 0; |
|
10478 local $Data::Dumper::Quotekeys = 0; |
|
10479 local $Data::Dumper::Terse = 1; |
|
10480 - TEST q(Dumper($a)); |
|
10481 - TEST q(Data::Dumper::DumperX($a)) if $XS; |
|
10482 + TEST (q(Dumper($a)), |
|
10483 + 'Purity 0: Quotekeys 0: Terse 1: Dumper'); |
|
10484 + TEST (q(Data::Dumper::DumperX($a)), |
|
10485 + 'Purity 0: Quotekeys 0: Terse 1: DumperX') |
|
10486 + if $XS; |
|
10487 } |
|
10488 |
|
10489 |
|
10490 @@ -295,21 +330,10 @@ |
|
10491 }; |
|
10492 { |
|
10493 local $Data::Dumper::Useqq = 1; |
|
10494 - TEST q(Dumper($foo)); |
|
10495 + TEST (q(Dumper($foo)), 'Useqq: Dumper'); |
|
10496 + TEST (q(Data::Dumper::DumperX($foo)), 'Useqq: DumperX') if $XS; |
|
10497 } |
|
10498 |
|
10499 - $WANT = <<"EOT"; |
|
10500 -#\$VAR1 = { |
|
10501 -# 'abc\0\\'\efg' => 'mno\0', |
|
10502 -# 'reftest' => \\\\1 |
|
10503 -#}; |
|
10504 -EOT |
|
10505 - |
|
10506 - { |
|
10507 - local $Data::Dumper::Useqq = 1; |
|
10508 - TEST q(Data::Dumper::DumperX($foo)) if $XS; # cheat |
|
10509 - } |
|
10510 - |
|
10511 |
|
10512 |
|
10513 ############# |
|
10514 @@ -353,8 +377,11 @@ |
|
10515 |
|
10516 $Data::Dumper::Purity = 1; |
|
10517 $Data::Dumper::Indent = 3; |
|
10518 - TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])); |
|
10519 - TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS; |
|
10520 + TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), |
|
10521 + 'Purity 1: Indent 3: Dump()'); |
|
10522 + TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), |
|
10523 + 'Purity 1: Indent 3: Dumpxs()') |
|
10524 + if $XS; |
|
10525 |
|
10526 ############# 55 |
|
10527 ## |
|
10528 @@ -381,8 +408,11 @@ |
|
10529 EOT |
|
10530 |
|
10531 $Data::Dumper::Indent = 1; |
|
10532 - TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])); |
|
10533 - TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS; |
|
10534 + TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), |
|
10535 + 'Purity 1: Indent 1: Dump()'); |
|
10536 + TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), |
|
10537 + 'Purity 1: Indent 1: Dumpxs()') |
|
10538 + if $XS; |
|
10539 |
|
10540 ############# 61 |
|
10541 ## |
|
10542 @@ -408,8 +438,11 @@ |
|
10543 #$foo = $bar[1]; |
|
10544 EOT |
|
10545 |
|
10546 - TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])); |
|
10547 - TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS; |
|
10548 + TEST (q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])), |
|
10549 + 'array|hash|glob dereferenced: Dump()'); |
|
10550 + TEST (q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])), |
|
10551 + 'array|hash|glob dereferenced: Dumpxs()') |
|
10552 + if $XS; |
|
10553 |
|
10554 ############# 67 |
|
10555 ## |
|
10556 @@ -435,8 +468,11 @@ |
|
10557 #$foo = $bar->[1]; |
|
10558 EOT |
|
10559 |
|
10560 - TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])); |
|
10561 - TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS; |
|
10562 + TEST (q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])), |
|
10563 + 'array|hash|glob: not dereferenced: Dump()'); |
|
10564 + TEST (q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])), |
|
10565 + 'array|hash|glob: not dereferenced: Dumpxs()') |
|
10566 + if $XS; |
|
10567 |
|
10568 ############# 73 |
|
10569 ## |
|
10570 @@ -457,8 +493,11 @@ |
|
10571 |
|
10572 $Data::Dumper::Purity = 0; |
|
10573 $Data::Dumper::Quotekeys = 0; |
|
10574 - TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])); |
|
10575 - TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS; |
|
10576 + TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), |
|
10577 + 'Purity 0: Quotekeys 0: dereferenced: Dump()'); |
|
10578 + TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])), |
|
10579 + 'Purity 0: Quotekeys 0: dereferenced: Dumpxs') |
|
10580 + if $XS; |
|
10581 |
|
10582 ############# 79 |
|
10583 ## |
|
10584 @@ -477,8 +516,11 @@ |
|
10585 #$baz = $bar->[2]; |
|
10586 EOT |
|
10587 |
|
10588 - TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])); |
|
10589 - TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS; |
|
10590 + TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), |
|
10591 + 'Purity 0: Quotekeys 0: not dereferenced: Dump()'); |
|
10592 + TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])), |
|
10593 + 'Purity 0: Quotekeys 0: not dereferenced: Dumpxs()') |
|
10594 + if $XS; |
|
10595 |
|
10596 } |
|
10597 |
|
10598 @@ -494,7 +536,7 @@ |
|
10599 $dogs[2] = \%kennel; |
|
10600 $mutts = \%kennel; |
|
10601 $mutts = $mutts; # avoid warning |
|
10602 - |
|
10603 + |
|
10604 ############# 85 |
|
10605 ## |
|
10606 $WANT = <<'EOT'; |
|
10607 @@ -510,19 +552,21 @@ |
|
10608 #%mutts = %kennels; |
|
10609 EOT |
|
10610 |
|
10611 - TEST q( |
|
10612 + TEST (q( |
|
10613 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts], |
|
10614 [qw(*kennels *dogs *mutts)] ); |
|
10615 $d->Dump; |
|
10616 - ); |
|
10617 + ), |
|
10618 + 'constructor: hash|array|scalar: Dump()'); |
|
10619 if ($XS) { |
|
10620 - TEST q( |
|
10621 + TEST (q( |
|
10622 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts], |
|
10623 [qw(*kennels *dogs *mutts)] ); |
|
10624 $d->Dumpxs; |
|
10625 - ); |
|
10626 + ), |
|
10627 + 'constructor: hash|array|scalar: Dumpxs()'); |
|
10628 } |
|
10629 - |
|
10630 + |
|
10631 ############# 91 |
|
10632 ## |
|
10633 $WANT = <<'EOT'; |
|
10634 @@ -531,9 +575,9 @@ |
|
10635 #%mutts = %kennels; |
|
10636 EOT |
|
10637 |
|
10638 - TEST q($d->Dump); |
|
10639 - TEST q($d->Dumpxs) if $XS; |
|
10640 - |
|
10641 + TEST q($d->Dump), 'object call: Dump'; |
|
10642 + TEST q($d->Dumpxs), 'object call: Dumpxs' if $XS; |
|
10643 + |
|
10644 ############# 97 |
|
10645 ## |
|
10646 $WANT = <<'EOT'; |
|
10647 @@ -549,10 +593,9 @@ |
|
10648 #%mutts = %kennels; |
|
10649 EOT |
|
10650 |
|
10651 - |
|
10652 - TEST q($d->Reset; $d->Dump); |
|
10653 + TEST q($d->Reset; $d->Dump), 'Reset and Dump separate calls'; |
|
10654 if ($XS) { |
|
10655 - TEST q($d->Reset; $d->Dumpxs); |
|
10656 + TEST (q($d->Reset; $d->Dumpxs), 'Reset and Dumpxs separate calls'); |
|
10657 } |
|
10658 |
|
10659 ############# 103 |
|
10660 @@ -570,24 +613,26 @@ |
|
10661 #%mutts = %{$dogs[2]}; |
|
10662 EOT |
|
10663 |
|
10664 - TEST q( |
|
10665 + TEST (q( |
|
10666 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts], |
|
10667 [qw(*dogs *kennels *mutts)] ); |
|
10668 $d->Dump; |
|
10669 - ); |
|
10670 + ), |
|
10671 + 'constructor: array|hash|scalar: Dump()'); |
|
10672 if ($XS) { |
|
10673 - TEST q( |
|
10674 + TEST (q( |
|
10675 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts], |
|
10676 [qw(*dogs *kennels *mutts)] ); |
|
10677 $d->Dumpxs; |
|
10678 - ); |
|
10679 + ), |
|
10680 + 'constructor: array|hash|scalar: Dumpxs()'); |
|
10681 } |
|
10682 - |
|
10683 + |
|
10684 ############# 109 |
|
10685 ## |
|
10686 - TEST q($d->Reset->Dump); |
|
10687 + TEST q($d->Reset->Dump), 'Reset Dump chained'; |
|
10688 if ($XS) { |
|
10689 - TEST q($d->Reset->Dumpxs); |
|
10690 + TEST q($d->Reset->Dumpxs), 'Reset Dumpxs chained'; |
|
10691 } |
|
10692 |
|
10693 ############# 115 |
|
10694 @@ -607,14 +652,20 @@ |
|
10695 #); |
|
10696 EOT |
|
10697 |
|
10698 - TEST q( |
|
10699 + TEST (q( |
|
10700 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] ); |
|
10701 $d->Deepcopy(1)->Dump; |
|
10702 - ); |
|
10703 + ), |
|
10704 + 'Deepcopy(1): Dump'); |
|
10705 if ($XS) { |
|
10706 - TEST q($d->Reset->Dumpxs); |
|
10707 +# TEST 'q($d->Reset->Dumpxs); |
|
10708 + TEST (q( |
|
10709 + $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] ); |
|
10710 + $d->Deepcopy(1)->Dumpxs; |
|
10711 + ), |
|
10712 + 'Deepcopy(1): Dumpxs'); |
|
10713 } |
|
10714 - |
|
10715 + |
|
10716 } |
|
10717 |
|
10718 { |
|
10719 @@ -631,8 +682,10 @@ |
|
10720 #]; |
|
10721 EOT |
|
10722 |
|
10723 -TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;); |
|
10724 -TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;) |
|
10725 +TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;), |
|
10726 + 'Seen: scalar: Dump'); |
|
10727 +TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;), |
|
10728 + 'Seen: scalar: Dumpxs') |
|
10729 if $XS; |
|
10730 |
|
10731 ############# 127 |
|
10732 @@ -644,8 +697,10 @@ |
|
10733 #]; |
|
10734 EOT |
|
10735 |
|
10736 -TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;); |
|
10737 -TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;) |
|
10738 +TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;), |
|
10739 + 'Seen: glob: Dump'); |
|
10740 +TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;), |
|
10741 + 'Seen: glob: Dumpxs') |
|
10742 if $XS; |
|
10743 |
|
10744 ############# 133 |
|
10745 @@ -657,8 +712,11 @@ |
|
10746 #); |
|
10747 EOT |
|
10748 |
|
10749 -TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;); |
|
10750 -TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;) |
|
10751 +TEST (q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;), |
|
10752 + 'Seen: glob: dereference: Dump'); |
|
10753 +TEST (q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => |
|
10754 +\&z})->Dumpxs;), |
|
10755 + 'Seen: glob: derference: Dumpxs') |
|
10756 if $XS; |
|
10757 |
|
10758 } |
|
10759 @@ -677,8 +735,10 @@ |
|
10760 #$a[1] = \$a[0]; |
|
10761 EOT |
|
10762 |
|
10763 -TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;); |
|
10764 -TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;) |
|
10765 +TEST (q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;), |
|
10766 + 'Purity(1): dereference: Dump'); |
|
10767 +TEST (q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;), |
|
10768 + 'Purity(1): dereference: Dumpxs') |
|
10769 if $XS; |
|
10770 } |
|
10771 |
|
10772 @@ -693,8 +753,10 @@ |
|
10773 #$b = ${${$a}}; |
|
10774 EOT |
|
10775 |
|
10776 -TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;); |
|
10777 -TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;) |
|
10778 +TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;), |
|
10779 + 'Purity(1): not dereferenced: Dump'); |
|
10780 +TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;), |
|
10781 + 'Purity(1): not dereferenced: Dumpxs') |
|
10782 if $XS; |
|
10783 } |
|
10784 |
|
10785 @@ -725,8 +787,10 @@ |
|
10786 #$b = ${$a->[0]{a}}; |
|
10787 EOT |
|
10788 |
|
10789 -TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;); |
|
10790 -TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;) |
|
10791 +TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;), |
|
10792 + 'Purity(1): Dump again'); |
|
10793 +TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;), |
|
10794 + 'Purity(1); Dumpxs again') |
|
10795 if $XS; |
|
10796 } |
|
10797 |
|
10798 @@ -751,8 +815,10 @@ |
|
10799 #$c = ${${$a->[0][0][0][0]}}; |
|
10800 EOT |
|
10801 |
|
10802 -TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;); |
|
10803 -TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;) |
|
10804 +TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;), |
|
10805 + 'Purity(1): Dump: 3 elements'); |
|
10806 +TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;), |
|
10807 + 'Purity(1): Dumpxs: 3 elements') |
|
10808 if $XS; |
|
10809 } |
|
10810 |
|
10811 @@ -780,8 +846,10 @@ |
|
10812 #$c = $a->{b}{c}; |
|
10813 EOT |
|
10814 |
|
10815 -TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;); |
|
10816 -TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;) |
|
10817 +TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;), |
|
10818 + 'Maxdepth(4): Dump()'); |
|
10819 +TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;), |
|
10820 + 'Maxdepth(4): Dumpxs()') |
|
10821 if $XS; |
|
10822 |
|
10823 ############# 169 |
|
10824 @@ -796,8 +864,10 @@ |
|
10825 #]; |
|
10826 EOT |
|
10827 |
|
10828 -TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;); |
|
10829 -TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;) |
|
10830 +TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;), |
|
10831 + 'Maxdepth(1): Dump()'); |
|
10832 +TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;), |
|
10833 + 'Maxdepth(1): Dumpxs()') |
|
10834 if $XS; |
|
10835 } |
|
10836 |
|
10837 @@ -813,8 +883,10 @@ |
|
10838 #]; |
|
10839 EOT |
|
10840 |
|
10841 -TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;); |
|
10842 -TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;) |
|
10843 +TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;), |
|
10844 + 'Purity(0): Dump()'); |
|
10845 +TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;), |
|
10846 + 'Purity(0): Dumpxs()') |
|
10847 if $XS; |
|
10848 |
|
10849 ############# 181 |
|
10850 @@ -827,8 +899,10 @@ |
|
10851 EOT |
|
10852 |
|
10853 |
|
10854 -TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;); |
|
10855 -TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;) |
|
10856 +TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;), |
|
10857 + 'Purity(1): Dump()'); |
|
10858 +TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;), |
|
10859 + 'Purity(1): Dumpxs') |
|
10860 if $XS; |
|
10861 } |
|
10862 |
|
10863 @@ -869,8 +943,10 @@ |
|
10864 #}; |
|
10865 EOT |
|
10866 |
|
10867 -TEST q(Data::Dumper->new([$a])->Dump;); |
|
10868 -TEST q(Data::Dumper->new([$a])->Dumpxs;) |
|
10869 +TEST (q(Data::Dumper->new([$a])->Dump;), |
|
10870 + 'basic test without names: Dump()'); |
|
10871 +TEST (q(Data::Dumper->new([$a])->Dumpxs;), |
|
10872 + 'basic test without names: Dumpxs()') |
|
10873 if $XS; |
|
10874 } |
|
10875 |
|
10876 @@ -899,11 +975,8 @@ |
|
10877 #}; |
|
10878 EOT |
|
10879 |
|
10880 -# perl code does keys and values as numbers if possible |
|
10881 -TEST q(Data::Dumper->new([$c])->Dump;); |
|
10882 -# XS code always does them as strings |
|
10883 -$WANT =~ s/ (\d+)/ '$1'/gs; |
|
10884 -TEST q(Data::Dumper->new([$c])->Dumpxs;) |
|
10885 +TEST q(Data::Dumper->new([$c])->Dump;), "sortkeys sub"; |
|
10886 +TEST q(Data::Dumper->new([$c])->Dumpxs;), "sortkeys sub (XS)" |
|
10887 if $XS; |
|
10888 } |
|
10889 |
|
10890 @@ -914,7 +987,7 @@ |
|
10891 local $Data::Dumper::Sortkeys = \&sort205; |
|
10892 sub sort205 { |
|
10893 my $hash = shift; |
|
10894 - return [ |
|
10895 + return [ |
|
10896 $hash eq $c ? (sort { $a <=> $b } keys %$hash) |
|
10897 : (reverse sort keys %$hash) |
|
10898 ]; |
|
10899 @@ -949,9 +1022,10 @@ |
|
10900 #]; |
|
10901 EOT |
|
10902 |
|
10903 -TEST q(Data::Dumper->new([[$c, $d]])->Dump;); |
|
10904 -$WANT =~ s/ (\d+)/ '$1'/gs; |
|
10905 -TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;) |
|
10906 +TEST q(Data::Dumper->new([[$c, $d]])->Dump;), "more sortkeys sub"; |
|
10907 +# the XS code does number values as strings |
|
10908 +$WANT =~ s/ (\d+)(,?)$/ '$1'$2/gm; |
|
10909 +TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;), "more sortkeys sub (XS)" |
|
10910 if $XS; |
|
10911 } |
|
10912 |
|
10913 @@ -972,7 +1046,8 @@ |
|
10914 if(" $Config{'extensions'} " !~ m[ B ]) { |
|
10915 SKIP_TEST "Perl configured without B module"; |
|
10916 } else { |
|
10917 - TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump); |
|
10918 + TEST (q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump), |
|
10919 + 'Deparse 1: Indent 2; Dump()'); |
|
10920 } |
|
10921 } |
|
10922 |
|
10923 @@ -1387,8 +1462,11 @@ |
|
10924 %ping = (chr (0xDECAF) x 4 =>\$ping); |
|
10925 for $Data::Dumper::Sortkeys (0, 1) { |
|
10926 if($] >= 5.007) { |
|
10927 - TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong'])); |
|
10928 - TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS; |
|
10929 + TEST (q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong'])), |
|
10930 + "utf8: Purity 1: Sortkeys: Dump()"); |
|
10931 + TEST (q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])), |
|
10932 + "utf8: Purity 1: Sortkeys: Dumpxs()") |
|
10933 + if $XS; |
|
10934 } else { |
|
10935 SKIP_TEST "Incomplete support for UTF-8 in old perls"; |
|
10936 SKIP_TEST "Incomplete support for UTF-8 in old perls"; |
|
10937 @@ -1425,8 +1503,183 @@ |
|
10938 EOT |
|
10939 @foo = (); |
|
10940 $foo[2] = 1; |
|
10941 - TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <[email protected]>'; |
|
10942 - TEST q(Data::Dumper->Dumpxs([\@foo])) if $XS; |
|
10943 + TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <[email protected]>: Dump()'; |
|
10944 + TEST q(Data::Dumper->Dumpxs([\@foo])), 'Richard Clamp, Message-Id: <[email protected]>: Dumpxs()'if $XS; |
|
10945 } |
|
10946 |
|
10947 +############# 364 |
|
10948 +# Make sure $obj->Dumpxs returns the right thing in list context. This was |
|
10949 +# broken by the initial attempt to fix [perl #74170]. |
|
10950 +$WANT = <<'EOT'; |
|
10951 +#$VAR1 = []; |
|
10952 +EOT |
|
10953 +TEST q(join " ", new Data::Dumper [[]],[] =>->Dumpxs), |
|
10954 + '$obj->Dumpxs in list context' |
|
10955 + if $XS; |
|
10956 + |
|
10957 +############# 366 |
|
10958 +{ |
|
10959 + $WANT = <<'EOT'; |
|
10960 +#$VAR1 = [ |
|
10961 +# "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377" |
|
10962 +#]; |
|
10963 +EOT |
|
10964 |
|
10965 + $foo = [ join "", map chr, 0..255 ]; |
|
10966 + local $Data::Dumper::Useqq = 1; |
|
10967 + TEST (q(Dumper($foo)), 'All latin1 characters: Dumper'); |
|
10968 + TEST (q(Data::Dumper::DumperX($foo)), 'All latin1 characters: DumperX') if $XS; |
|
10969 +} |
|
10970 + |
|
10971 +############# 372 |
|
10972 +{ |
|
10973 + $WANT = <<'EOT'; |
|
10974 +#$VAR1 = [ |
|
10975 +# "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\x{80}\x{81}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8d}\x{8e}\x{8f}\x{90}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9d}\x{9e}\x{9f}\x{a0}\x{a1}\x{a2}\x{a3}\x{a4}\x{a5}\x{a6}\x{a7}\x{a8}\x{a9}\x{aa}\x{ab}\x{ac}\x{ad}\x{ae}\x{af}\x{b0}\x{b1}\x{b2}\x{b3}\x{b4}\x{b5}\x{b6}\x{b7}\x{b8}\x{b9}\x{ba}\x{bb}\x{bc}\x{bd}\x{be}\x{bf}\x{c0}\x{c1}\x{c2}\x{c3}\x{c4}\x{c5}\x{c6}\x{c7}\x{c8}\x{c9}\x{ca}\x{cb}\x{cc}\x{cd}\x{ce}\x{cf}\x{d0}\x{d1}\x{d2}\x{d3}\x{d4}\x{d5}\x{d6}\x{d7}\x{d8}\x{d9}\x{da}\x{db}\x{dc}\x{dd}\x{de}\x{df}\x{e0}\x{e1}\x{e2}\x{e3}\x{e4}\x{e5}\x{e6}\x{e7}\x{e8}\x{e9}\x{ea}\x{eb}\x{ec}\x{ed}\x{ee}\x{ef}\x{f0}\x{f1}\x{f2}\x{f3}\x{f4}\x{f5}\x{f6}\x{f7}\x{f8}\x{f9}\x{fa}\x{fb}\x{fc}\x{fd}\x{fe}\x{ff}\x{20ac}" |
|
10976 +#]; |
|
10977 +EOT |
|
10978 + |
|
10979 + $foo = [ join "", map chr, 0..255, 0x20ac ]; |
|
10980 + local $Data::Dumper::Useqq = 1; |
|
10981 + if ($] < 5.007) { |
|
10982 + print "not ok " . (++$TNUM) . " # TODO - fails under 5.6\n" for 1..3; |
|
10983 + } |
|
10984 + else { |
|
10985 + TEST q(Dumper($foo)), |
|
10986 + 'All latin1 characters with utf8 flag including a wide character: Dumper'; |
|
10987 + } |
|
10988 + TEST (q(Data::Dumper::DumperX($foo)), |
|
10989 + 'All latin1 characters with utf8 flag including a wide character: DumperX') |
|
10990 + if $XS; |
|
10991 +} |
|
10992 + |
|
10993 +############# 378 |
|
10994 +{ |
|
10995 + # If XS cannot load, the pure-Perl version cannot deparse vstrings with |
|
10996 + # underscores properly. In 5.8.0, vstrings are just strings. |
|
10997 + my $no_vstrings = <<'NOVSTRINGS'; |
|
10998 +#$a = \'ABC'; |
|
10999 +#$b = \'ABC'; |
|
11000 +#$c = \'ABC'; |
|
11001 +#$d = \'ABC'; |
|
11002 +NOVSTRINGS |
|
11003 + my $vstrings_corr = <<'VSTRINGS_CORRECT'; |
|
11004 +#$a = \v65.66.67; |
|
11005 +#$b = \v65.66.067; |
|
11006 +#$c = \v65.66.6_7; |
|
11007 +#$d = \'ABC'; |
|
11008 +VSTRINGS_CORRECT |
|
11009 + $WANT = $] <= 5.0080001 |
|
11010 + ? $no_vstrings |
|
11011 + : $vstrings_corr; |
|
11012 + |
|
11013 + @::_v = ( |
|
11014 + \v65.66.67, |
|
11015 + \($] < 5.007 ? v65.66.67 : eval 'v65.66.067'), |
|
11016 + \v65.66.6_7, |
|
11017 + \~v190.189.188 |
|
11018 + ); |
|
11019 + if ($] >= 5.010) { |
|
11020 + TEST q(Data::Dumper->Dump(\@::_v, [qw(a b c d)])), 'vstrings'; |
|
11021 + TEST q(Data::Dumper->Dumpxs(\@::_v, [qw(a b c d)])), 'xs vstrings' |
|
11022 + if $XS; |
|
11023 + } |
|
11024 + else { # Skip tests before 5.10. vstrings considered funny before |
|
11025 + SKIP_TEST "vstrings considered funny before 5.10.0"; |
|
11026 + SKIP_TEST "vstrings considered funny before 5.10.0 (XS)" |
|
11027 + if $XS; |
|
11028 + } |
|
11029 +} |
|
11030 + |
|
11031 +############# 384 |
|
11032 +{ |
|
11033 + # [perl #107372] blessed overloaded globs |
|
11034 + $WANT = <<'EOW'; |
|
11035 +#$VAR1 = bless( \*::finkle, 'overtest' ); |
|
11036 +EOW |
|
11037 + { |
|
11038 + package overtest; |
|
11039 + use overload fallback=>1, q\""\=>sub{"oaoaa"}; |
|
11040 + } |
|
11041 + TEST q(Data::Dumper->Dump([bless \*finkle, "overtest"])), |
|
11042 + 'blessed overloaded globs'; |
|
11043 + TEST q(Data::Dumper->Dumpxs([\*finkle])), 'blessed overloaded globs (xs)' |
|
11044 + if $XS; |
|
11045 +} |
|
11046 +############# 390 |
|
11047 +{ |
|
11048 + # [perl #74798] uncovered behaviour |
|
11049 + $WANT = <<'EOW'; |
|
11050 +#$VAR1 = "\0000"; |
|
11051 +EOW |
|
11052 + local $Data::Dumper::Useqq = 1; |
|
11053 + TEST q(Data::Dumper->Dump(["\x000"])), |
|
11054 + "\\ octal followed by digit"; |
|
11055 + TEST q(Data::Dumper->Dumpxs(["\x000"])), '\\ octal followed by digit (xs)' |
|
11056 + if $XS; |
|
11057 + |
|
11058 + $WANT = <<'EOW'; |
|
11059 +#$VAR1 = "\x{100}\0000"; |
|
11060 +EOW |
|
11061 + local $Data::Dumper::Useqq = 1; |
|
11062 + TEST q(Data::Dumper->Dump(["\x{100}\x000"])), |
|
11063 + "\\ octal followed by digit unicode"; |
|
11064 + TEST q(Data::Dumper->Dumpxs(["\x{100}\x000"])), '\\ octal followed by digit unicode (xs)' |
|
11065 + if $XS; |
|
11066 + |
|
11067 + |
|
11068 + $WANT = <<'EOW'; |
|
11069 +#$VAR1 = "\0\x{660}"; |
|
11070 +EOW |
|
11071 + TEST q(Data::Dumper->Dump(["\\x00\\x{0660}"])), |
|
11072 + "\\ octal followed by unicode digit"; |
|
11073 + TEST q(Data::Dumper->Dumpxs(["\\x00\\x{0660}"])), '\\ octal followed by unicode digit (xs)' |
|
11074 + if $XS; |
|
11075 + |
|
11076 + # [perl #118933 - handling of digits |
|
11077 +$WANT = <<'EOW'; |
|
11078 +#$VAR1 = 0; |
|
11079 +#$VAR2 = 1; |
|
11080 +#$VAR3 = 90; |
|
11081 +#$VAR4 = -10; |
|
11082 +#$VAR5 = "010"; |
|
11083 +#$VAR6 = 112345678; |
|
11084 +#$VAR7 = "1234567890"; |
|
11085 +EOW |
|
11086 + TEST q(Data::Dumper->Dump([0, 1, 90, -10, "010", "112345678", "1234567890" ])), |
|
11087 + "numbers and number-like scalars"; |
|
11088 + |
|
11089 + TEST q(Data::Dumper->Dumpxs([0, 1, 90, -10, "010", "112345678", "1234567890" ])), |
|
11090 + "numbers and number-like scalars" |
|
11091 + if $XS; |
|
11092 +} |
|
11093 +############# 426 |
|
11094 +{ |
|
11095 + # [perl #82948] |
|
11096 + # re::regexp_pattern was moved to universal.c in v5.10.0-252-g192c1e2 |
|
11097 + # and apparently backported to maint-5.10 |
|
11098 + $WANT = $] > 5.010 ? <<'NEW' : <<'OLD'; |
|
11099 +#$VAR1 = qr/abc/; |
|
11100 +#$VAR2 = qr/abc/i; |
|
11101 +NEW |
|
11102 +#$VAR1 = qr/(?-xism:abc)/; |
|
11103 +#$VAR2 = qr/(?i-xsm:abc)/; |
|
11104 +OLD |
|
11105 + TEST q(Data::Dumper->Dump([ qr/abc/, qr/abc/i ])), "qr//"; |
|
11106 + TEST q(Data::Dumper->Dumpxs([ qr/abc/, qr/abc/i ])), "qr// xs" |
|
11107 + if $XS; |
|
11108 +} |
|
11109 +############# 432 |
|
11110 + |
|
11111 +{ |
|
11112 + sub foo {} |
|
11113 + $WANT = <<'EOW'; |
|
11114 +#*a = sub { "DUMMY" }; |
|
11115 +#$b = \&a; |
|
11116 +EOW |
|
11117 + |
|
11118 + TEST q(Data::Dumper->new([ \&foo, \\&foo ], [ "*a", "b" ])->Dump), "name of code in *foo"; |
|
11119 + TEST q(Data::Dumper->new([ \&foo, \\&foo ], [ "*a", "b" ])->Dumpxs), "name of code in *foo xs" |
|
11120 + if $XS; |
|
11121 +} |
|
11122 +############# 436 |
|
11123 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/dumpperl.t perl-5.12.5_dumper/dist/Data-Dumper/t/dumpperl.t |
|
11124 --- perl-5.12.5/dist/Data-Dumper/t/dumpperl.t 1969-12-31 19:00:00.000000000 -0500 |
|
11125 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/dumpperl.t 2014-10-09 15:06:36.179445704 -0400 |
|
11126 @@ -0,0 +1,144 @@ |
|
11127 +#!./perl -w |
|
11128 +# t/dumpperl.t - test all branches of, and modes of triggering, Dumpperl() |
|
11129 +BEGIN { |
|
11130 + if ($ENV{PERL_CORE}){ |
|
11131 + require Config; import Config; |
|
11132 + no warnings 'once'; |
|
11133 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
11134 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
11135 + exit 0; |
|
11136 + } |
|
11137 + } |
|
11138 +} |
|
11139 + |
|
11140 +use strict; |
|
11141 +use Carp; |
|
11142 +use Data::Dumper; |
|
11143 +use Test::More tests => 31; |
|
11144 +use lib qw( ./t/lib ); |
|
11145 +use Testing qw( _dumptostr ); |
|
11146 + |
|
11147 +$Data::Dumper::Indent=1; |
|
11148 + |
|
11149 +{ |
|
11150 + local $Data::Dumper::Useperl=1; |
|
11151 + local $Data::Dumper::Useqq=0; |
|
11152 + local $Data::Dumper::Deparse=0; |
|
11153 + note('$Data::Dumper::Useperl => 1'); |
|
11154 + run_tests_for_pure_perl_implementations(); |
|
11155 +} |
|
11156 + |
|
11157 +{ |
|
11158 + local $Data::Dumper::Useperl=0; |
|
11159 + local $Data::Dumper::Useqq=1; |
|
11160 + local $Data::Dumper::Deparse=0; |
|
11161 + note('$Data::Dumper::Useqq => 1'); |
|
11162 + run_tests_for_pure_perl_implementations(); |
|
11163 +} |
|
11164 + |
|
11165 +{ |
|
11166 + local $Data::Dumper::Useperl=0; |
|
11167 + local $Data::Dumper::Useqq=0; |
|
11168 + local $Data::Dumper::Deparse=1; |
|
11169 + note('$Data::Dumper::Deparse => 1'); |
|
11170 + run_tests_for_pure_perl_implementations(); |
|
11171 +} |
|
11172 + |
|
11173 + |
|
11174 + |
|
11175 +sub run_tests_for_pure_perl_implementations { |
|
11176 + |
|
11177 + my ($a, $b, $obj); |
|
11178 + my (@names); |
|
11179 + my (@newnames, $objagain, %newnames); |
|
11180 + my $dumpstr; |
|
11181 + $a = 'alpha'; |
|
11182 + $b = 'beta'; |
|
11183 + my @c = ( qw| eta theta | ); |
|
11184 + my %d = ( iota => 'kappa' ); |
|
11185 + |
|
11186 + note('names not provided'); |
|
11187 + $obj = Data::Dumper->new([$a, $b]); |
|
11188 + $dumpstr = _dumptostr($obj); |
|
11189 + like($dumpstr, |
|
11190 + qr/\$VAR1.+alpha.+\$VAR2.+beta/s, |
|
11191 + "Dump: two strings" |
|
11192 + ); |
|
11193 + |
|
11194 + $obj = Data::Dumper->new([$a, \@c]); |
|
11195 + $dumpstr = _dumptostr($obj); |
|
11196 + like($dumpstr, |
|
11197 + qr/\$VAR1.+alpha.+\$VAR2.+\[.+eta.+theta.+\]/s, |
|
11198 + "Dump: one string, one array ref" |
|
11199 + ); |
|
11200 + |
|
11201 + $obj = Data::Dumper->new([$a, \%d]); |
|
11202 + $dumpstr = _dumptostr($obj); |
|
11203 + like($dumpstr, |
|
11204 + qr/\$VAR1.+alpha.+\$VAR2.+\{.+iota.+kappa.+\}/s, |
|
11205 + "Dump: one string, one hash ref" |
|
11206 + ); |
|
11207 + |
|
11208 + $obj = Data::Dumper->new([$a, undef]); |
|
11209 + $dumpstr = _dumptostr($obj); |
|
11210 + like($dumpstr, |
|
11211 + qr/\$VAR1.+alpha.+\$VAR2.+undef/s, |
|
11212 + "Dump: one string, one undef" |
|
11213 + ); |
|
11214 + |
|
11215 + note('names provided'); |
|
11216 + |
|
11217 + $obj = Data::Dumper->new([$a, $b], [ qw( a b ) ]); |
|
11218 + $dumpstr = _dumptostr($obj); |
|
11219 + like($dumpstr, |
|
11220 + qr/\$a.+alpha.+\$b.+beta/s, |
|
11221 + "Dump: names: two strings" |
|
11222 + ); |
|
11223 + |
|
11224 + $obj = Data::Dumper->new([$a, \@c], [ qw( a *c ) ]); |
|
11225 + $dumpstr = _dumptostr($obj); |
|
11226 + like($dumpstr, |
|
11227 + qr/\$a.+alpha.+\@c.+eta.+theta/s, |
|
11228 + "Dump: names: one string, one array ref" |
|
11229 + ); |
|
11230 + |
|
11231 + $obj = Data::Dumper->new([$a, \%d], [ qw( a *d ) ]); |
|
11232 + $dumpstr = _dumptostr($obj); |
|
11233 + like($dumpstr, |
|
11234 + qr/\$a.+alpha.+\%d.+iota.+kappa/s, |
|
11235 + "Dump: names: one string, one hash ref" |
|
11236 + ); |
|
11237 + |
|
11238 + $obj = Data::Dumper->new([$a,undef], [qw(a *c)]); |
|
11239 + $dumpstr = _dumptostr($obj); |
|
11240 + like($dumpstr, |
|
11241 + qr/\$a.+alpha.+\$c.+undef/s, |
|
11242 + "Dump: names: one string, one undef" |
|
11243 + ); |
|
11244 + |
|
11245 + $obj = Data::Dumper->new([$a, $b], [ 'a', '']); |
|
11246 + $dumpstr = _dumptostr($obj); |
|
11247 + like($dumpstr, |
|
11248 + qr/\$a.+alpha.+\$.+beta/s, |
|
11249 + "Dump: names: two strings: one name empty" |
|
11250 + ); |
|
11251 + |
|
11252 + $obj = Data::Dumper->new([$a, $b], [ 'a', '$foo']); |
|
11253 + $dumpstr = _dumptostr($obj); |
|
11254 + no warnings 'uninitialized'; |
|
11255 + like($dumpstr, |
|
11256 + qr/\$a.+alpha.+\$foo.+beta/s, |
|
11257 + "Dump: names: two strings: one name start with '\$'" |
|
11258 + ); |
|
11259 + use warnings; |
|
11260 +} |
|
11261 + |
|
11262 +{ |
|
11263 + my ($obj, $dumpstr, $realtype); |
|
11264 + $obj = Data::Dumper->new([ {IO => *{$::{STDERR}}{IO}} ]); |
|
11265 + $obj->Useperl(1); |
|
11266 + eval { $dumpstr = _dumptostr($obj); }; |
|
11267 + $realtype = 'IO'; |
|
11268 + like($@, qr/Can't handle '$realtype' type/, |
|
11269 + "Got expected error: pure-perl: Data-Dumper does not handle $realtype"); |
|
11270 +} |
|
11271 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/freezer_useperl.t perl-5.12.5_dumper/dist/Data-Dumper/t/freezer_useperl.t |
|
11272 --- perl-5.12.5/dist/Data-Dumper/t/freezer_useperl.t 1969-12-31 19:00:00.000000000 -0500 |
|
11273 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/freezer_useperl.t 2014-10-09 15:06:36.176584265 -0400 |
|
11274 @@ -0,0 +1,106 @@ |
|
11275 +#!./perl -w |
|
11276 +# |
|
11277 +# test a few problems with the Freezer option, not a complete Freezer |
|
11278 +# test suite yet |
|
11279 + |
|
11280 +BEGIN { |
|
11281 + require Config; import Config; |
|
11282 + no warnings 'once'; |
|
11283 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
11284 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
11285 + exit 0; |
|
11286 + } |
|
11287 +} |
|
11288 + |
|
11289 +use strict; |
|
11290 +use Test::More tests => 7; |
|
11291 +use Data::Dumper; |
|
11292 +use lib qw( ./t/lib ); |
|
11293 +use Testing qw( _dumptostr ); |
|
11294 + |
|
11295 +local $Data::Dumper::Useperl = 1; |
|
11296 + |
|
11297 +{ |
|
11298 + local $Data::Dumper::Freezer = 'freeze'; |
|
11299 + |
|
11300 + # test for seg-fault bug when freeze() returns a non-ref |
|
11301 + { |
|
11302 + my $foo = Test1->new("foo"); |
|
11303 + my $dumped_foo = Dumper($foo); |
|
11304 + ok($dumped_foo, |
|
11305 + "Use of freezer sub which returns non-ref worked."); |
|
11306 + like($dumped_foo, qr/frozed/, |
|
11307 + "Dumped string has the key added by Freezer with useperl."); |
|
11308 + like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /, |
|
11309 + "Dumped list doesn't begin with Freezer's return value with useperl"); |
|
11310 + } |
|
11311 + |
|
11312 + # test for warning when an object does not have a freeze() |
|
11313 + { |
|
11314 + my $warned = 0; |
|
11315 + local $SIG{__WARN__} = sub { $warned++ }; |
|
11316 + my $bar = Test2->new("bar"); |
|
11317 + my $dumped_bar = Dumper($bar); |
|
11318 + is($warned, 0, "A missing freeze() shouldn't warn."); |
|
11319 + } |
|
11320 + |
|
11321 + # a freeze() which die()s should still trigger the warning |
|
11322 + { |
|
11323 + my $warned = 0; |
|
11324 + local $SIG{__WARN__} = sub { $warned++; }; |
|
11325 + my $bar = Test3->new("bar"); |
|
11326 + my $dumped_bar = Dumper($bar); |
|
11327 + is($warned, 1, "A freeze() which die()s should warn."); |
|
11328 + } |
|
11329 + |
|
11330 +} |
|
11331 + |
|
11332 +{ |
|
11333 + my ($obj, %dumps); |
|
11334 + my $foo = Test1->new("foo"); |
|
11335 + |
|
11336 + local $Data::Dumper::Freezer = ''; |
|
11337 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11338 + $dumps{'ddfemptystr'} = _dumptostr($obj); |
|
11339 + |
|
11340 + local $Data::Dumper::Freezer = undef; |
|
11341 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11342 + $dumps{'ddfundef'} = _dumptostr($obj); |
|
11343 + |
|
11344 + is($dumps{'ddfundef'}, $dumps{'ddfemptystr'}, |
|
11345 + "\$Data::Dumper::Freezer same with empty string or undef"); |
|
11346 +} |
|
11347 + |
|
11348 +{ |
|
11349 + my ($obj, %dumps); |
|
11350 + my $foo = Test1->new("foo"); |
|
11351 + |
|
11352 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11353 + $obj->Freezer(''); |
|
11354 + $dumps{'objemptystr'} = _dumptostr($obj); |
|
11355 + |
|
11356 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11357 + $obj->Freezer(undef); |
|
11358 + $dumps{'objundef'} = _dumptostr($obj); |
|
11359 + |
|
11360 + is($dumps{'objundef'}, $dumps{'objemptystr'}, |
|
11361 + "Freezer() same with empty string or undef"); |
|
11362 +} |
|
11363 + |
|
11364 + |
|
11365 +# a package with a freeze() which returns a non-ref |
|
11366 +package Test1; |
|
11367 +sub new { bless({name => $_[1]}, $_[0]) } |
|
11368 +sub freeze { |
|
11369 + my $self = shift; |
|
11370 + $self->{frozed} = 1; |
|
11371 +} |
|
11372 + |
|
11373 +# a package without a freeze() |
|
11374 +package Test2; |
|
11375 +sub new { bless({name => $_[1]}, $_[0]) } |
|
11376 + |
|
11377 +# a package with a freeze() which dies |
|
11378 +package Test3; |
|
11379 +sub new { bless({name => $_[1]}, $_[0]) } |
|
11380 +sub freeze { die "freeze() is broken" } |
|
11381 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/freezer.t perl-5.12.5_dumper/dist/Data-Dumper/t/freezer.t |
|
11382 --- perl-5.12.5/dist/Data-Dumper/t/freezer.t 2012-11-03 19:25:59.000000000 -0400 |
|
11383 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/freezer.t 2014-10-09 15:06:36.179907539 -0400 |
|
11384 @@ -7,74 +7,104 @@ |
|
11385 require Config; import Config; |
|
11386 no warnings 'once'; |
|
11387 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
11388 - print "1..0 # Skip: Data::Dumper was not built\n"; |
|
11389 - exit 0; |
|
11390 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
11391 + exit 0; |
|
11392 } |
|
11393 } |
|
11394 |
|
11395 use strict; |
|
11396 -use Test::More qw(no_plan); |
|
11397 +use Test::More tests => 8; |
|
11398 use Data::Dumper; |
|
11399 -$Data::Dumper::Freezer = 'freeze'; |
|
11400 +use lib qw( ./t/lib ); |
|
11401 +use Testing qw( _dumptostr ); |
|
11402 |
|
11403 -# test for seg-fault bug when freeze() returns a non-ref |
|
11404 -my $foo = Test1->new("foo"); |
|
11405 -my $dumped_foo = Dumper($foo); |
|
11406 -ok($dumped_foo, |
|
11407 - "Use of freezer sub which returns non-ref worked."); |
|
11408 -like($dumped_foo, qr/frozed/, |
|
11409 - "Dumped string has the key added by Freezer."); |
|
11410 - |
|
11411 -# run the same tests with useperl. this always worked |
|
11412 { |
|
11413 - local $Data::Dumper::Useperl = 1; |
|
11414 - my $foo = Test1->new("foo"); |
|
11415 - my $dumped_foo = Dumper($foo); |
|
11416 - ok($dumped_foo, |
|
11417 - "Use of freezer sub which returns non-ref worked with useperl"); |
|
11418 - like($dumped_foo, qr/frozed/, |
|
11419 - "Dumped string has the key added by Freezer with useperl."); |
|
11420 + local $Data::Dumper::Freezer = 'freeze'; |
|
11421 + |
|
11422 + # test for seg-fault bug when freeze() returns a non-ref |
|
11423 + { |
|
11424 + my $foo = Test1->new("foo"); |
|
11425 + my $dumped_foo = Dumper($foo); |
|
11426 + ok($dumped_foo, |
|
11427 + "Use of freezer sub which returns non-ref worked."); |
|
11428 + like($dumped_foo, qr/frozed/, |
|
11429 + "Dumped string has the key added by Freezer with useperl."); |
|
11430 + like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /, |
|
11431 + "Dumped list doesn't begin with Freezer's return value with useperl"); |
|
11432 + } |
|
11433 + |
|
11434 + |
|
11435 + # test for warning when an object does not have a freeze() |
|
11436 + { |
|
11437 + my $warned = 0; |
|
11438 + local $SIG{__WARN__} = sub { $warned++ }; |
|
11439 + my $bar = Test2->new("bar"); |
|
11440 + my $dumped_bar = Dumper($bar); |
|
11441 + is($warned, 0, "A missing freeze() shouldn't warn."); |
|
11442 + } |
|
11443 + |
|
11444 + |
|
11445 + # a freeze() which die()s should still trigger the warning |
|
11446 + { |
|
11447 + my $warned = 0; |
|
11448 + local $SIG{__WARN__} = sub { $warned++; }; |
|
11449 + my $bar = Test3->new("bar"); |
|
11450 + my $dumped_bar = Dumper($bar); |
|
11451 + is($warned, 1, "A freeze() which die()s should warn."); |
|
11452 + } |
|
11453 + |
|
11454 } |
|
11455 |
|
11456 -# test for warning when an object doesn't have a freeze() |
|
11457 { |
|
11458 - my $warned = 0; |
|
11459 - local $SIG{__WARN__} = sub { $warned++ }; |
|
11460 - my $bar = Test2->new("bar"); |
|
11461 - my $dumped_bar = Dumper($bar); |
|
11462 - is($warned, 0, "A missing freeze() shouldn't warn."); |
|
11463 -} |
|
11464 + my ($obj, %dumps); |
|
11465 + my $foo = Test1->new("foo"); |
|
11466 |
|
11467 + local $Data::Dumper::Freezer = 'freeze'; |
|
11468 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11469 + $dumps{'ddftrue'} = _dumptostr($obj); |
|
11470 + local $Data::Dumper::Freezer = ''; |
|
11471 + |
|
11472 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11473 + $obj->Freezer('freeze'); |
|
11474 + $dumps{'objset'} = _dumptostr($obj); |
|
11475 |
|
11476 -# run the same test with useperl, which always worked |
|
11477 -{ |
|
11478 - local $Data::Dumper::Useperl = 1; |
|
11479 - my $warned = 0; |
|
11480 - local $SIG{__WARN__} = sub { $warned++ }; |
|
11481 - my $bar = Test2->new("bar"); |
|
11482 - my $dumped_bar = Dumper($bar); |
|
11483 - is($warned, 0, "A missing freeze() shouldn't warn with useperl"); |
|
11484 + is($dumps{'ddftrue'}, $dumps{'objset'}, |
|
11485 + "\$Data::Dumper::Freezer and Freezer() are equivalent"); |
|
11486 } |
|
11487 |
|
11488 -# a freeze() which die()s should still trigger the warning |
|
11489 { |
|
11490 - my $warned = 0; |
|
11491 - local $SIG{__WARN__} = sub { $warned++; }; |
|
11492 - my $bar = Test3->new("bar"); |
|
11493 - my $dumped_bar = Dumper($bar); |
|
11494 - is($warned, 1, "A freeze() which die()s should warn."); |
|
11495 + my ($obj, %dumps); |
|
11496 + my $foo = Test1->new("foo"); |
|
11497 + |
|
11498 + local $Data::Dumper::Freezer = ''; |
|
11499 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11500 + $dumps{'ddfemptystr'} = _dumptostr($obj); |
|
11501 + |
|
11502 + local $Data::Dumper::Freezer = undef; |
|
11503 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11504 + $dumps{'ddfundef'} = _dumptostr($obj); |
|
11505 + |
|
11506 + is($dumps{'ddfundef'}, $dumps{'ddfemptystr'}, |
|
11507 + "\$Data::Dumper::Freezer same with empty string or undef"); |
|
11508 } |
|
11509 |
|
11510 -# the same should work in useperl |
|
11511 { |
|
11512 - local $Data::Dumper::Useperl = 1; |
|
11513 - my $warned = 0; |
|
11514 - local $SIG{__WARN__} = sub { $warned++; }; |
|
11515 - my $bar = Test3->new("bar"); |
|
11516 - my $dumped_bar = Dumper($bar); |
|
11517 - is($warned, 1, "A freeze() which die()s should warn with useperl."); |
|
11518 + my ($obj, %dumps); |
|
11519 + my $foo = Test1->new("foo"); |
|
11520 + |
|
11521 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11522 + $obj->Freezer(''); |
|
11523 + $dumps{'objemptystr'} = _dumptostr($obj); |
|
11524 + |
|
11525 + $obj = Data::Dumper->new( [ $foo ] ); |
|
11526 + $obj->Freezer(undef); |
|
11527 + $dumps{'objundef'} = _dumptostr($obj); |
|
11528 + |
|
11529 + is($dumps{'objundef'}, $dumps{'objemptystr'}, |
|
11530 + "Freezer() same with empty string or undef"); |
|
11531 } |
|
11532 |
|
11533 + |
|
11534 # a package with a freeze() which returns a non-ref |
|
11535 package Test1; |
|
11536 sub new { bless({name => $_[1]}, $_[0]) } |
|
11537 @@ -90,4 +120,4 @@ |
|
11538 # a package with a freeze() which dies |
|
11539 package Test3; |
|
11540 sub new { bless({name => $_[1]}, $_[0]) } |
|
11541 -sub freeze { die "freeze() is broked" } |
|
11542 +sub freeze { die "freeze() is broken" } |
|
11543 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/indent.t perl-5.12.5_dumper/dist/Data-Dumper/t/indent.t |
|
11544 --- perl-5.12.5/dist/Data-Dumper/t/indent.t 1969-12-31 19:00:00.000000000 -0500 |
|
11545 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/indent.t 2014-10-09 15:06:36.178235441 -0400 |
|
11546 @@ -0,0 +1,113 @@ |
|
11547 +#!./perl -w |
|
11548 +# t/indent.t - Test Indent() |
|
11549 +BEGIN { |
|
11550 + if ($ENV{PERL_CORE}){ |
|
11551 + require Config; import Config; |
|
11552 + no warnings 'once'; |
|
11553 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
11554 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
11555 + exit 0; |
|
11556 + } |
|
11557 + } |
|
11558 +} |
|
11559 + |
|
11560 +use strict; |
|
11561 + |
|
11562 +use Data::Dumper; |
|
11563 +use Test::More tests => 10; |
|
11564 +use lib qw( ./t/lib ); |
|
11565 +use Testing qw( _dumptostr ); |
|
11566 + |
|
11567 + |
|
11568 +my $hash = { foo => 42 }; |
|
11569 + |
|
11570 +my (%dumpstr); |
|
11571 +my $dumper; |
|
11572 + |
|
11573 +$dumper = Data::Dumper->new([$hash]); |
|
11574 +$dumpstr{noindent} = _dumptostr($dumper); |
|
11575 +# $VAR1 = { |
|
11576 +# 'foo' => 42 |
|
11577 +# }; |
|
11578 + |
|
11579 +$dumper = Data::Dumper->new([$hash]); |
|
11580 +$dumper->Indent(); |
|
11581 +$dumpstr{indent_no_arg} = _dumptostr($dumper); |
|
11582 + |
|
11583 +$dumper = Data::Dumper->new([$hash]); |
|
11584 +$dumper->Indent(undef); |
|
11585 +$dumpstr{indent_undef} = _dumptostr($dumper); |
|
11586 + |
|
11587 +$dumper = Data::Dumper->new([$hash]); |
|
11588 +$dumper->Indent(0); |
|
11589 +$dumpstr{indent_0} = _dumptostr($dumper); |
|
11590 +# $VAR1 = {'foo' => 42}; # no newline |
|
11591 + |
|
11592 +$dumper = Data::Dumper->new([$hash]); |
|
11593 +$dumper->Indent(1); |
|
11594 +$dumpstr{indent_1} = _dumptostr($dumper); |
|
11595 +# $VAR1 = { |
|
11596 +# 'foo' => 42 |
|
11597 +# }; |
|
11598 + |
|
11599 +$dumper = Data::Dumper->new([$hash]); |
|
11600 +$dumper->Indent(2); |
|
11601 +$dumpstr{indent_2} = _dumptostr($dumper); |
|
11602 +# $VAR1 = { |
|
11603 +# 'foo' => 42 |
|
11604 +# }; |
|
11605 + |
|
11606 +is($dumpstr{noindent}, $dumpstr{indent_no_arg}, |
|
11607 + "absence of Indent is same as Indent()"); |
|
11608 +is($dumpstr{noindent}, $dumpstr{indent_undef}, |
|
11609 + "absence of Indent is same as Indent(undef)"); |
|
11610 +isnt($dumpstr{noindent}, $dumpstr{indent_0}, |
|
11611 + "absence of Indent is different from Indent(0)"); |
|
11612 +isnt($dumpstr{indent_0}, $dumpstr{indent_1}, |
|
11613 + "Indent(0) is different from Indent(1)"); |
|
11614 +cmp_ok(length($dumpstr{indent_0}), '<=', length($dumpstr{indent_1}), |
|
11615 + "Indent(0) is more compact than Indent(1)"); |
|
11616 +is($dumpstr{noindent}, $dumpstr{indent_2}, |
|
11617 + "absence of Indent is same as Indent(2), i.e., 2 is default"); |
|
11618 +cmp_ok(length($dumpstr{indent_1}), '<=', length($dumpstr{indent_2}), |
|
11619 + "Indent(1) is more compact than Indent(2)"); |
|
11620 + |
|
11621 +my $array = [ qw| foo 42 | ]; |
|
11622 +$dumper = Data::Dumper->new([$array]); |
|
11623 +$dumper->Indent(2); |
|
11624 +$dumpstr{ar_indent_2} = _dumptostr($dumper); |
|
11625 +# $VAR1 = [ |
|
11626 +# 'foo', |
|
11627 +# '42' |
|
11628 +# ]; |
|
11629 + |
|
11630 +$dumper = Data::Dumper->new([$array]); |
|
11631 +$dumper->Indent(3); |
|
11632 +$dumpstr{ar_indent_3} = _dumptostr($dumper); |
|
11633 +# $VAR1 = [ |
|
11634 +# #0 |
|
11635 +# 'foo', |
|
11636 +# #1 |
|
11637 +# '42' |
|
11638 +# ]; |
|
11639 + |
|
11640 +isnt($dumpstr{ar_indent_2}, $dumpstr{ar_indent_3}, |
|
11641 + "On arrays, Indent(2) is different from Indent(3)"); |
|
11642 +like($dumpstr{ar_indent_3}, |
|
11643 + qr/\#0.+'foo'.+\#1.+42/s, |
|
11644 + "Indent(3) annotates array elements with their indices" |
|
11645 +); |
|
11646 +{ |
|
11647 + no if $] < 5.011, warnings => 'deprecated'; |
|
11648 + is(scalar(split("\n" => $dumpstr{ar_indent_2})) + 2, |
|
11649 + scalar(split("\n" => $dumpstr{ar_indent_3})), |
|
11650 + "Indent(3) runs 2 lines longer than Indent(2)"); |
|
11651 +} |
|
11652 + |
|
11653 +__END__ |
|
11654 +is($dumpstr{noindent}, $dumpstr{indent_0}, |
|
11655 + "absence of Indent is same as Indent(0)"); |
|
11656 +isnt($dumpstr{noindent}, $dumpstr{indent_1}, |
|
11657 + "absence of Indent is different from Indent(1)"); |
|
11658 +print STDERR $dumpstr{indent_0}; |
|
11659 +print STDERR $dumpstr{ar_indent_3}; |
|
11660 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/lib/Testing.pm perl-5.12.5_dumper/dist/Data-Dumper/t/lib/Testing.pm |
|
11661 --- perl-5.12.5/dist/Data-Dumper/t/lib/Testing.pm 1969-12-31 19:00:00.000000000 -0500 |
|
11662 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/lib/Testing.pm 2014-10-09 15:06:36.173740795 -0400 |
|
11663 @@ -0,0 +1,15 @@ |
|
11664 +package Testing; |
|
11665 +use 5.006_001; |
|
11666 +use strict; |
|
11667 +use warnings; |
|
11668 +require Exporter; |
|
11669 +our @ISA = qw(Exporter); |
|
11670 +our @EXPORT_OK = qw(_dumptostr); |
|
11671 +use Carp; |
|
11672 + |
|
11673 +sub _dumptostr { |
|
11674 + my ($obj) = @_; |
|
11675 + return join '', $obj->Dump; |
|
11676 +} |
|
11677 + |
|
11678 +1; |
|
11679 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/misc.t perl-5.12.5_dumper/dist/Data-Dumper/t/misc.t |
|
11680 --- perl-5.12.5/dist/Data-Dumper/t/misc.t 1969-12-31 19:00:00.000000000 -0500 |
|
11681 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/misc.t 2014-10-09 15:06:36.174735741 -0400 |
|
11682 @@ -0,0 +1,209 @@ |
|
11683 +#!./perl -w |
|
11684 +# t/misc.t - Test various functionality |
|
11685 + |
|
11686 +BEGIN { |
|
11687 + if ($ENV{PERL_CORE}){ |
|
11688 + require Config; import Config; |
|
11689 + no warnings 'once'; |
|
11690 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
11691 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
11692 + exit 0; |
|
11693 + } |
|
11694 + } |
|
11695 +} |
|
11696 + |
|
11697 +use strict; |
|
11698 + |
|
11699 +use Data::Dumper; |
|
11700 +use Test::More tests => 20; |
|
11701 +use lib qw( ./t/lib ); |
|
11702 +use Testing qw( _dumptostr ); |
|
11703 + |
|
11704 +my ($a, $b, @c, %d); |
|
11705 +$a = 'alpha'; |
|
11706 +$b = 'beta'; |
|
11707 +@c = ( qw| gamma delta epsilon | ); |
|
11708 +%d = ( zeta => 'eta', theta => 'iota' ); |
|
11709 + |
|
11710 +note("Argument validation for new()"); |
|
11711 +{ |
|
11712 + local $@ = ''; |
|
11713 + eval { my $obj = Data::Dumper->new(undef); }; |
|
11714 + like($@, |
|
11715 + qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/, |
|
11716 + "Got error message: new() needs defined argument" |
|
11717 + ); |
|
11718 +} |
|
11719 + |
|
11720 +{ |
|
11721 + local $@ = ''; |
|
11722 + eval { my $obj = Data::Dumper->new( { $a => $b } ); }; |
|
11723 + like($@, |
|
11724 + qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/, |
|
11725 + "Got error message: new() needs array reference" |
|
11726 + ); |
|
11727 +} |
|
11728 + |
|
11729 +{ |
|
11730 + note("\$Data::Dumper::Useperl, Useqq, Deparse"); |
|
11731 + my ($obj, %dumpstr); |
|
11732 + |
|
11733 + local $Data::Dumper::Useperl = 1; |
|
11734 + $obj = Data::Dumper->new( [ \@c, \%d ] ); |
|
11735 + $dumpstr{useperl} = [ $obj->Values ]; |
|
11736 + local $Data::Dumper::Useperl = 0; |
|
11737 + |
|
11738 + local $Data::Dumper::Useqq = 1; |
|
11739 + $obj = Data::Dumper->new( [ \@c, \%d ] ); |
|
11740 + $dumpstr{useqq} = [ $obj->Values ]; |
|
11741 + local $Data::Dumper::Useqq = 0; |
|
11742 + |
|
11743 + is_deeply($dumpstr{useperl}, $dumpstr{useqq}, |
|
11744 + "Useperl and Useqq return same"); |
|
11745 + |
|
11746 + local $Data::Dumper::Deparse = 1; |
|
11747 + $obj = Data::Dumper->new( [ \@c, \%d ] ); |
|
11748 + $dumpstr{deparse} = [ $obj->Values ]; |
|
11749 + local $Data::Dumper::Deparse = 0; |
|
11750 + |
|
11751 + is_deeply($dumpstr{useperl}, $dumpstr{deparse}, |
|
11752 + "Useperl and Deparse return same"); |
|
11753 +} |
|
11754 + |
|
11755 +{ |
|
11756 + note("\$Data::Dumper::Pad and \$obj->Pad"); |
|
11757 + my ($obj, %dumps, $pad); |
|
11758 + $obj = Data::Dumper->new([$a,$b]); |
|
11759 + $dumps{'noprev'} = _dumptostr($obj); |
|
11760 + |
|
11761 + $obj = Data::Dumper->new([$a,$b]); |
|
11762 + $obj->Pad(undef); |
|
11763 + $dumps{'undef'} = _dumptostr($obj); |
|
11764 + |
|
11765 + $obj = Data::Dumper->new([$a,$b]); |
|
11766 + $obj->Pad(''); |
|
11767 + $dumps{'emptystring'} = _dumptostr($obj); |
|
11768 + |
|
11769 + is($dumps{'noprev'}, $dumps{'undef'}, |
|
11770 + "No setting for \$Data::Dumper::Pad and Pad(undef) give same result"); |
|
11771 + |
|
11772 + is($dumps{'noprev'}, $dumps{'emptystring'}, |
|
11773 + "No setting for \$Data::Dumper::Pad and Pad('') give same result"); |
|
11774 + |
|
11775 + $pad = 'XXX: '; |
|
11776 + local $Data::Dumper::Pad = $pad; |
|
11777 + $obj = Data::Dumper->new([$a,$b]); |
|
11778 + $dumps{'ddp'} = _dumptostr($obj); |
|
11779 + local $Data::Dumper::Pad = ''; |
|
11780 + |
|
11781 + $obj = Data::Dumper->new([$a,$b]); |
|
11782 + $obj->Pad($pad); |
|
11783 + $dumps{'obj'} = _dumptostr($obj); |
|
11784 + |
|
11785 + is($dumps{'ddp'}, $dumps{'obj'}, |
|
11786 + "\$Data::Dumper::Pad and \$obj->Pad() give same result"); |
|
11787 + |
|
11788 + is( (grep {! /^$pad/} (split(/\n/, $dumps{'ddp'}))), 0, |
|
11789 + "Each line of dumped output padded as expected"); |
|
11790 +} |
|
11791 + |
|
11792 +{ |
|
11793 + note("\$Data::Dumper::Varname and \$obj->Varname"); |
|
11794 + my ($obj, %dumps, $varname); |
|
11795 + $obj = Data::Dumper->new([$a,$b]); |
|
11796 + $dumps{'noprev'} = _dumptostr($obj); |
|
11797 + |
|
11798 + $obj = Data::Dumper->new([$a,$b]); |
|
11799 + $obj->Varname(undef); |
|
11800 + $dumps{'undef'} = _dumptostr($obj); |
|
11801 + |
|
11802 + $obj = Data::Dumper->new([$a,$b]); |
|
11803 + $obj->Varname(''); |
|
11804 + $dumps{'emptystring'} = _dumptostr($obj); |
|
11805 + |
|
11806 + is($dumps{'noprev'}, $dumps{'undef'}, |
|
11807 + "No setting for \$Data::Dumper::Varname and Varname(undef) give same result"); |
|
11808 + |
|
11809 + # Because Varname defaults to '$VAR', providing an empty argument to |
|
11810 + # Varname produces a non-default result. |
|
11811 + isnt($dumps{'noprev'}, $dumps{'emptystring'}, |
|
11812 + "No setting for \$Data::Dumper::Varname and Varname('') give different results"); |
|
11813 + |
|
11814 + $varname = 'MIMI'; |
|
11815 + local $Data::Dumper::Varname = $varname; |
|
11816 + $obj = Data::Dumper->new([$a,$b]); |
|
11817 + $dumps{'ddv'} = _dumptostr($obj); |
|
11818 + local $Data::Dumper::Varname = undef; |
|
11819 + |
|
11820 + $obj = Data::Dumper->new([$a,$b]); |
|
11821 + $obj->Varname($varname); |
|
11822 + $dumps{'varname'} = _dumptostr($obj); |
|
11823 + |
|
11824 + is($dumps{'ddv'}, $dumps{'varname'}, |
|
11825 + "Setting for \$Data::Dumper::Varname and Varname() give same result"); |
|
11826 + |
|
11827 + is( (grep { /^\$$varname/ } (split(/\n/, $dumps{'ddv'}))), 2, |
|
11828 + "All lines of dumped output use provided varname"); |
|
11829 + |
|
11830 + is( (grep { /^\$VAR/ } (split(/\n/, $dumps{'ddv'}))), 0, |
|
11831 + "No lines of dumped output use default \$VAR"); |
|
11832 +} |
|
11833 + |
|
11834 +{ |
|
11835 + note("\$Data::Dumper::Useqq and \$obj->Useqq"); |
|
11836 + my ($obj, %dumps, $useqq); |
|
11837 + $obj = Data::Dumper->new([$a,$b]); |
|
11838 + $dumps{'noprev'} = _dumptostr($obj); |
|
11839 + |
|
11840 + $obj = Data::Dumper->new([$a,$b]); |
|
11841 + $obj->Useqq(undef); |
|
11842 + $dumps{'undef'} = _dumptostr($obj); |
|
11843 + |
|
11844 + $obj = Data::Dumper->new([$a,$b]); |
|
11845 + $obj->Useqq(''); |
|
11846 + $dumps{'emptystring'} = _dumptostr($obj); |
|
11847 + |
|
11848 + $obj = Data::Dumper->new([$a,$b]); |
|
11849 + $obj->Useqq(0); |
|
11850 + $dumps{'zero'} = _dumptostr($obj); |
|
11851 + |
|
11852 + my $current = $Data::Dumper::Useqq; |
|
11853 + local $Data::Dumper::Useqq = 0; |
|
11854 + $obj = Data::Dumper->new([$a,$b]); |
|
11855 + $dumps{'dduzero'} = _dumptostr($obj); |
|
11856 + local $Data::Dumper::Useqq = $current; |
|
11857 + |
|
11858 + is($dumps{'noprev'}, $dumps{'undef'}, |
|
11859 + "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result"); |
|
11860 + |
|
11861 + is($dumps{'noprev'}, $dumps{'zero'}, |
|
11862 + "No setting for \$Data::Dumper::Useqq and Useqq(0) give same result"); |
|
11863 + |
|
11864 + is($dumps{'noprev'}, $dumps{'emptystring'}, |
|
11865 + "No setting for \$Data::Dumper::Useqq and Useqq('') give same result"); |
|
11866 + |
|
11867 + is($dumps{'noprev'}, $dumps{'dduzero'}, |
|
11868 + "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result"); |
|
11869 + |
|
11870 + local $Data::Dumper::Useqq = 1; |
|
11871 + $obj = Data::Dumper->new([$a,$b]); |
|
11872 + $dumps{'ddu'} = _dumptostr($obj); |
|
11873 + local $Data::Dumper::Useqq = $current; |
|
11874 + |
|
11875 + $obj = Data::Dumper->new([$a,$b]); |
|
11876 + $obj->Useqq(1); |
|
11877 + $dumps{'obj'} = _dumptostr($obj); |
|
11878 + |
|
11879 + is($dumps{'ddu'}, $dumps{'obj'}, |
|
11880 + "\$Data::Dumper::Useqq=1 and Useqq(1) give same result"); |
|
11881 + |
|
11882 + like($dumps{'ddu'}, |
|
11883 + qr/"$a".+?"$b"/s, |
|
11884 + "Double-quotes used around values" |
|
11885 + ); |
|
11886 + |
|
11887 + unlike($dumps{'ddu'}, |
|
11888 + qr/'$a'.+?'$b'/s, |
|
11889 + "Single-quotes not used around values" |
|
11890 + ); |
|
11891 +} |
|
11892 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/names.t perl-5.12.5_dumper/dist/Data-Dumper/t/names.t |
|
11893 --- perl-5.12.5/dist/Data-Dumper/t/names.t 1969-12-31 19:00:00.000000000 -0500 |
|
11894 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/names.t 2014-10-09 15:06:36.178953190 -0400 |
|
11895 @@ -0,0 +1,66 @@ |
|
11896 +#!./perl -w |
|
11897 + |
|
11898 +BEGIN { |
|
11899 + if ($ENV{PERL_CORE}){ |
|
11900 + require Config; import Config; |
|
11901 + no warnings 'once'; |
|
11902 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
11903 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
11904 + exit 0; |
|
11905 + } |
|
11906 + } |
|
11907 +} |
|
11908 + |
|
11909 +use strict; |
|
11910 +use Carp; |
|
11911 +use Data::Dumper; |
|
11912 +use Test::More tests => 15; |
|
11913 +use lib qw( ./t/lib ); |
|
11914 +use Testing qw( _dumptostr ); |
|
11915 + |
|
11916 +my ($a, $b, $obj); |
|
11917 +my (@names); |
|
11918 +my (@newnames, $objagain, %newnames); |
|
11919 +my $dumpstr; |
|
11920 +$a = 'alpha'; |
|
11921 +$b = 'beta'; |
|
11922 + |
|
11923 +$obj = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
11924 +@names = $obj->Names; |
|
11925 +is_deeply(\@names, [qw(a b)], "Names() returned expected list"); |
|
11926 + |
|
11927 +@newnames = ( qw| gamma delta | ); |
|
11928 +$objagain = $obj->Names(\@newnames); |
|
11929 +is($objagain, $obj, "Names returned same object"); |
|
11930 +is_deeply($objagain->{names}, \@newnames, |
|
11931 + "Able to use Names() to set names to be dumped"); |
|
11932 + |
|
11933 +$obj = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
11934 +%newnames = ( gamma => 'delta', epsilon => 'zeta' ); |
|
11935 +eval { @names = $obj->Names(\%newnames); }; |
|
11936 +like($@, qr/Argument to Names, if provided, must be array ref/, |
|
11937 + "Got expected error message: bad argument to Names()"); |
|
11938 + |
|
11939 +$obj = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
11940 +@newnames = ( qw| gamma delta epsilon | ); |
|
11941 +$objagain = $obj->Names(\@newnames); |
|
11942 +is($objagain, $obj, "Names returned same object"); |
|
11943 +is_deeply($objagain->{names}, \@newnames, |
|
11944 + "Able to use Names() to set names to be dumped"); |
|
11945 +$dumpstr = _dumptostr($obj); |
|
11946 +like($dumpstr, qr/gamma/s, "Got first name expected"); |
|
11947 +like($dumpstr, qr/delta/s, "Got first name expected"); |
|
11948 +unlike($dumpstr, qr/epsilon/s, "Did not get name which was not expected"); |
|
11949 + |
|
11950 +$obj = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
11951 +@newnames = ( qw| gamma | ); |
|
11952 +$objagain = $obj->Names(\@newnames); |
|
11953 +is($objagain, $obj, "Names returned same object"); |
|
11954 +is_deeply($objagain->{names}, \@newnames, |
|
11955 + "Able to use Names() to set names to be dumped"); |
|
11956 +$dumpstr = _dumptostr($obj); |
|
11957 +like($dumpstr, qr/gamma/s, "Got name expected"); |
|
11958 +unlike($dumpstr, qr/delta/s, "Did not get name which was not expected"); |
|
11959 +unlike($dumpstr, qr/epsilon/s, "Did not get name which was not expected"); |
|
11960 +like($dumpstr, qr/\$VAR2/s, "Got default name"); |
|
11961 + |
|
11962 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/overload.t perl-5.12.5_dumper/dist/Data-Dumper/t/overload.t |
|
11963 --- perl-5.12.5/dist/Data-Dumper/t/overload.t 2012-11-03 19:25:59.000000000 -0400 |
|
11964 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/overload.t 2014-10-09 15:06:36.177778379 -0400 |
|
11965 @@ -11,9 +11,10 @@ |
|
11966 } |
|
11967 } |
|
11968 |
|
11969 +use strict; |
|
11970 use Data::Dumper; |
|
11971 |
|
11972 -print "1..1\n"; |
|
11973 +use Test::More tests => 4; |
|
11974 |
|
11975 package Foo; |
|
11976 use overload '""' => 'as_string'; |
|
11977 @@ -25,12 +26,11 @@ |
|
11978 |
|
11979 my $f = Foo->new; |
|
11980 |
|
11981 -print "#\$f=$f\n"; |
|
11982 +isa_ok($f, 'Foo'); |
|
11983 +is("$f", '%%%%', 'String overloading works'); |
|
11984 |
|
11985 -$_ = Dumper($f); |
|
11986 -s/^/#/mg; |
|
11987 -print $_; |
|
11988 +my $d = Dumper($f); |
|
11989 |
|
11990 -print "not " unless /bar/ && /Foo/; |
|
11991 -print "ok 1\n"; |
|
11992 +like($d, qr/bar/); |
|
11993 +like($d, qr/Foo/); |
|
11994 |
|
11995 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/perl-74170.t perl-5.12.5_dumper/dist/Data-Dumper/t/perl-74170.t |
|
11996 --- perl-5.12.5/dist/Data-Dumper/t/perl-74170.t 1969-12-31 19:00:00.000000000 -0500 |
|
11997 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/perl-74170.t 2014-10-09 15:06:36.177564131 -0400 |
|
11998 @@ -0,0 +1,145 @@ |
|
11999 +#!perl -X |
|
12000 +# |
|
12001 +# Regression test for [perl #74170] (missing SPAGAIN after DD_Dump(...)): |
|
12002 +# Since it’s so large, it gets its own file. |
|
12003 + |
|
12004 +BEGIN { |
|
12005 + if ($ENV{PERL_CORE}){ |
|
12006 + require Config; import Config; |
|
12007 + no warnings 'once'; |
|
12008 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
12009 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
12010 + exit 0; |
|
12011 + } |
|
12012 + } |
|
12013 +} |
|
12014 +use strict; |
|
12015 +use Test::More tests => 1; |
|
12016 +use Data::Dumper; |
|
12017 + |
|
12018 +our %repos = real_life_setup(); |
|
12019 + |
|
12020 +$Data::Dumper::Indent = 1; |
|
12021 +# A custom sort sub is necessary for reproducing the bug, as this is where |
|
12022 +# the stack gets reallocated. |
|
12023 +$Data::Dumper::Sortkeys = sub { return [ reverse sort keys %{$_[0]} ]; } |
|
12024 + unless exists $ENV{NO_SORT_SUB}; |
|
12025 + |
|
12026 +ok(Data::Dumper->Dump([\%repos], [qw(*repos)]), "RT 74170 test"); |
|
12027 + |
|
12028 +sub real_life_setup { |
|
12029 + # set up the %repos hash in a manner that reflects a real run of |
|
12030 + # the gitolite "compiler" script: |
|
12031 + # Yes, all this is necessary to get the stack in such a state that the |
|
12032 + # custom sort sub will trigger a reallocation. |
|
12033 + my %repos; |
|
12034 + push @{ $repos{''}{'@all'} }, (); |
|
12035 + push @{ $repos{''}{'guser86'} }, (); |
|
12036 + push @{ $repos{''}{'guser87'} }, (); |
|
12037 + push @{ $repos{''}{'user88'} }, (); |
|
12038 + push @{ $repos{''}{'grussell'} }, (); |
|
12039 + push @{ $repos{''}{'guser0'} }, (); |
|
12040 + push @{ $repos{''}{'guser1'} }, (); |
|
12041 + push @{ $repos{''}{'guser10'} }, (); |
|
12042 + push @{ $repos{''}{'guser11'} }, (); |
|
12043 + push @{ $repos{''}{'guser12'} }, (); |
|
12044 + push @{ $repos{''}{'guser13'} }, (); |
|
12045 + push @{ $repos{''}{'guser14'} }, (); |
|
12046 + push @{ $repos{''}{'guser15'} }, (); |
|
12047 + push @{ $repos{''}{'guser16'} }, (); |
|
12048 + push @{ $repos{''}{'guser17'} }, (); |
|
12049 + push @{ $repos{''}{'guser18'} }, (); |
|
12050 + push @{ $repos{''}{'guser19'} }, (); |
|
12051 + push @{ $repos{''}{'guser2'} }, (); |
|
12052 + push @{ $repos{''}{'guser20'} }, (); |
|
12053 + push @{ $repos{''}{'guser21'} }, (); |
|
12054 + push @{ $repos{''}{'guser22'} }, (); |
|
12055 + push @{ $repos{''}{'guser23'} }, (); |
|
12056 + push @{ $repos{''}{'guser24'} }, (); |
|
12057 + push @{ $repos{''}{'guser25'} }, (); |
|
12058 + push @{ $repos{''}{'guser26'} }, (); |
|
12059 + push @{ $repos{''}{'guser27'} }, (); |
|
12060 + push @{ $repos{''}{'guser28'} }, (); |
|
12061 + push @{ $repos{''}{'guser29'} }, (); |
|
12062 + push @{ $repos{''}{'guser3'} }, (); |
|
12063 + push @{ $repos{''}{'guser30'} }, (); |
|
12064 + push @{ $repos{''}{'guser31'} }, (); |
|
12065 + push @{ $repos{''}{'guser32'} }, (); |
|
12066 + push @{ $repos{''}{'guser33'} }, (); |
|
12067 + push @{ $repos{''}{'guser34'} }, (); |
|
12068 + push @{ $repos{''}{'guser35'} }, (); |
|
12069 + push @{ $repos{''}{'guser36'} }, (); |
|
12070 + push @{ $repos{''}{'guser37'} }, (); |
|
12071 + push @{ $repos{''}{'guser38'} }, (); |
|
12072 + push @{ $repos{''}{'guser39'} }, (); |
|
12073 + push @{ $repos{''}{'guser4'} }, (); |
|
12074 + push @{ $repos{''}{'guser40'} }, (); |
|
12075 + push @{ $repos{''}{'guser41'} }, (); |
|
12076 + push @{ $repos{''}{'guser42'} }, (); |
|
12077 + push @{ $repos{''}{'guser43'} }, (); |
|
12078 + push @{ $repos{''}{'guser44'} }, (); |
|
12079 + push @{ $repos{''}{'guser45'} }, (); |
|
12080 + push @{ $repos{''}{'guser46'} }, (); |
|
12081 + push @{ $repos{''}{'guser47'} }, (); |
|
12082 + push @{ $repos{''}{'guser48'} }, (); |
|
12083 + push @{ $repos{''}{'guser49'} }, (); |
|
12084 + push @{ $repos{''}{'guser5'} }, (); |
|
12085 + push @{ $repos{''}{'guser50'} }, (); |
|
12086 + push @{ $repos{''}{'guser51'} }, (); |
|
12087 + push @{ $repos{''}{'guser52'} }, (); |
|
12088 + push @{ $repos{''}{'guser53'} }, (); |
|
12089 + push @{ $repos{''}{'guser54'} }, (); |
|
12090 + push @{ $repos{''}{'guser55'} }, (); |
|
12091 + push @{ $repos{''}{'guser56'} }, (); |
|
12092 + push @{ $repos{''}{'guser57'} }, (); |
|
12093 + push @{ $repos{''}{'guser58'} }, (); |
|
12094 + push @{ $repos{''}{'guser59'} }, (); |
|
12095 + push @{ $repos{''}{'guser6'} }, (); |
|
12096 + push @{ $repos{''}{'guser60'} }, (); |
|
12097 + push @{ $repos{''}{'guser61'} }, (); |
|
12098 + push @{ $repos{''}{'guser62'} }, (); |
|
12099 + push @{ $repos{''}{'guser63'} }, (); |
|
12100 + push @{ $repos{''}{'guser64'} }, (); |
|
12101 + push @{ $repos{''}{'guser65'} }, (); |
|
12102 + push @{ $repos{''}{'guser66'} }, (); |
|
12103 + push @{ $repos{''}{'guser67'} }, (); |
|
12104 + push @{ $repos{''}{'guser68'} }, (); |
|
12105 + push @{ $repos{''}{'guser69'} }, (); |
|
12106 + push @{ $repos{''}{'guser7'} }, (); |
|
12107 + push @{ $repos{''}{'guser70'} }, (); |
|
12108 + push @{ $repos{''}{'guser71'} }, (); |
|
12109 + push @{ $repos{''}{'guser72'} }, (); |
|
12110 + push @{ $repos{''}{'guser73'} }, (); |
|
12111 + push @{ $repos{''}{'guser74'} }, (); |
|
12112 + push @{ $repos{''}{'guser75'} }, (); |
|
12113 + push @{ $repos{''}{'guser76'} }, (); |
|
12114 + push @{ $repos{''}{'guser77'} }, (); |
|
12115 + push @{ $repos{''}{'guser78'} }, (); |
|
12116 + push @{ $repos{''}{'guser79'} }, (); |
|
12117 + push @{ $repos{''}{'guser8'} }, (); |
|
12118 + push @{ $repos{''}{'guser80'} }, (); |
|
12119 + push @{ $repos{''}{'guser81'} }, (); |
|
12120 + push @{ $repos{''}{'guser82'} }, (); |
|
12121 + push @{ $repos{''}{'guser83'} }, (); |
|
12122 + push @{ $repos{''}{'guser84'} }, (); |
|
12123 + push @{ $repos{''}{'guser85'} }, (); |
|
12124 + push @{ $repos{''}{'guser9'} }, (); |
|
12125 + push @{ $repos{''}{'user1'} }, (); |
|
12126 + push @{ $repos{''}{'user10'} }, (); |
|
12127 + push @{ $repos{''}{'user11'} }, (); |
|
12128 + push @{ $repos{''}{'user12'} }, (); |
|
12129 + push @{ $repos{''}{'user13'} }, (); |
|
12130 + push @{ $repos{''}{'user14'} }, (); |
|
12131 + push @{ $repos{''}{'user15'} }, (); |
|
12132 + push @{ $repos{''}{'user16'} }, (); |
|
12133 + push @{ $repos{''}{'user2'} }, (); |
|
12134 + push @{ $repos{''}{'user3'} }, (); |
|
12135 + push @{ $repos{''}{'user4'} }, (); |
|
12136 + push @{ $repos{''}{'user5'} }, (); |
|
12137 + push @{ $repos{''}{'user6'} }, (); |
|
12138 + push @{ $repos{''}{'user7'} }, (); |
|
12139 + $repos{''}{R}{'user8'} = 1; |
|
12140 + $repos{''}{W}{'user8'} = 1; |
|
12141 + push @{ $repos{''}{'user8'} }, (); |
|
12142 + return %repos; |
|
12143 +} |
|
12144 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t perl-5.12.5_dumper/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t |
|
12145 --- perl-5.12.5/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t 1969-12-31 19:00:00.000000000 -0500 |
|
12146 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t 2014-10-09 15:06:36.175174223 -0400 |
|
12147 @@ -0,0 +1,418 @@ |
|
12148 +#!./perl -w |
|
12149 +# t/purity_deepcopy_maxdepth.t - Test Purity(), Deepcopy(), |
|
12150 +# Maxdepth() and recursive structures |
|
12151 + |
|
12152 +BEGIN { |
|
12153 + if ($ENV{PERL_CORE}){ |
|
12154 + require Config; import Config; |
|
12155 + no warnings 'once'; |
|
12156 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
12157 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
12158 + exit 0; |
|
12159 + } |
|
12160 + } |
|
12161 +} |
|
12162 + |
|
12163 +use strict; |
|
12164 + |
|
12165 +use Data::Dumper; |
|
12166 +use Test::More tests => 24; |
|
12167 +use lib qw( ./t/lib ); |
|
12168 +use Testing qw( _dumptostr ); |
|
12169 + |
|
12170 +my ($a, $b, $c, @d); |
|
12171 +my ($d, $e, $f); |
|
12172 + |
|
12173 +note("\$Data::Dumper::Purity and Purity()"); |
|
12174 + |
|
12175 +{ |
|
12176 + my ($obj, %dumps, $purity); |
|
12177 + |
|
12178 + # Adapted from example in Dumper.pm POD: |
|
12179 + @d = ('c'); |
|
12180 + $c = \@d; |
|
12181 + $b = {}; |
|
12182 + $a = [1, $b, $c]; |
|
12183 + $b->{a} = $a; |
|
12184 + $b->{b} = $a->[1]; |
|
12185 + $b->{c} = $a->[2]; |
|
12186 + |
|
12187 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12188 + $dumps{'noprev'} = _dumptostr($obj); |
|
12189 + |
|
12190 + note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Purity = undef"); |
|
12191 + local $Data::Dumper::Useperl = 1; |
|
12192 + $purity = undef; |
|
12193 + local $Data::Dumper::Purity = $purity; |
|
12194 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12195 + $dumps{'ddpundef'} = _dumptostr($obj); |
|
12196 + |
|
12197 + $purity = 0; |
|
12198 + local $Data::Dumper::Purity = $purity; |
|
12199 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12200 + $dumps{'ddpzero'} = _dumptostr($obj); |
|
12201 + |
|
12202 + is($dumps{'noprev'}, $dumps{'ddpundef'}, |
|
12203 + "No previous Purity setting equivalent to \$Data::Dumper::Purity = undef"); |
|
12204 + |
|
12205 + is($dumps{'noprev'}, $dumps{'ddpzero'}, |
|
12206 + "No previous Purity setting equivalent to \$Data::Dumper::Purity = 0"); |
|
12207 +} |
|
12208 + |
|
12209 +{ |
|
12210 + my ($obj, %dumps, $purity); |
|
12211 + |
|
12212 + @d = ('c'); |
|
12213 + $c = \@d; |
|
12214 + $b = {}; |
|
12215 + $a = [1, $b, $c]; |
|
12216 + $b->{a} = $a; |
|
12217 + $b->{b} = $a->[1]; |
|
12218 + $b->{c} = $a->[2]; |
|
12219 + |
|
12220 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12221 + $dumps{'noprev'} = _dumptostr($obj); |
|
12222 + |
|
12223 + $purity = 0; |
|
12224 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12225 + $obj->Purity($purity); |
|
12226 + $dumps{'objzero'} = _dumptostr($obj); |
|
12227 + |
|
12228 + is($dumps{'noprev'}, $dumps{'objzero'}, |
|
12229 + "No previous Purity setting equivalent to Purity(0)"); |
|
12230 + |
|
12231 + $purity = undef; |
|
12232 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12233 + $obj->Purity($purity); |
|
12234 + $dumps{'objundef'} = _dumptostr($obj); |
|
12235 + |
|
12236 + is($dumps{'noprev'}, $dumps{'objundef'}, |
|
12237 + "No previous Purity setting equivalent to Purity(undef)"); |
|
12238 +} |
|
12239 + |
|
12240 +{ |
|
12241 + my ($obj, %dumps, $purity); |
|
12242 + |
|
12243 + @d = ('c'); |
|
12244 + $c = \@d; |
|
12245 + $b = {}; |
|
12246 + $a = [1, $b, $c]; |
|
12247 + $b->{a} = $a; |
|
12248 + $b->{b} = $a->[1]; |
|
12249 + $b->{c} = $a->[2]; |
|
12250 + |
|
12251 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12252 + $dumps{'noprev'} = _dumptostr($obj); |
|
12253 + |
|
12254 + $purity = 1; |
|
12255 + local $Data::Dumper::Purity = $purity; |
|
12256 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12257 + $dumps{'ddpone'} = _dumptostr($obj); |
|
12258 + |
|
12259 + isnt($dumps{'noprev'}, $dumps{'ddpone'}, |
|
12260 + "No previous Purity setting different from \$Data::Dumper::Purity = 1"); |
|
12261 +} |
|
12262 + |
|
12263 +{ |
|
12264 + my ($obj, %dumps, $purity); |
|
12265 + |
|
12266 + @d = ('c'); |
|
12267 + $c = \@d; |
|
12268 + $b = {}; |
|
12269 + $a = [1, $b, $c]; |
|
12270 + $b->{a} = $a; |
|
12271 + $b->{b} = $a->[1]; |
|
12272 + $b->{c} = $a->[2]; |
|
12273 + |
|
12274 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12275 + $dumps{'noprev'} = _dumptostr($obj); |
|
12276 + |
|
12277 + $purity = 1; |
|
12278 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12279 + $obj->Purity(1); |
|
12280 + $dumps{'objone'} = _dumptostr($obj); |
|
12281 + |
|
12282 + isnt($dumps{'noprev'}, $dumps{'objone'}, |
|
12283 + "No previous Purity setting different from Purity(0)"); |
|
12284 +} |
|
12285 + |
|
12286 +{ |
|
12287 + my ($obj, %dumps, $purity); |
|
12288 + |
|
12289 + @d = ('c'); |
|
12290 + $c = \@d; |
|
12291 + $b = {}; |
|
12292 + $a = [1, $b, $c]; |
|
12293 + $b->{a} = $a; |
|
12294 + $b->{b} = $a->[1]; |
|
12295 + $b->{c} = $a->[2]; |
|
12296 + |
|
12297 + $purity = 1; |
|
12298 + local $Data::Dumper::Purity = $purity; |
|
12299 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12300 + $dumps{'ddpone'} = _dumptostr($obj); |
|
12301 + local $Data::Dumper::Purity = undef; |
|
12302 + |
|
12303 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12304 + $obj->Purity(1); |
|
12305 + $dumps{'objone'} = _dumptostr($obj); |
|
12306 + |
|
12307 + is($dumps{'ddpone'}, $dumps{'objone'}, |
|
12308 + "\$Data::Dumper::Purity = 1 and Purity(1) are equivalent"); |
|
12309 +} |
|
12310 + |
|
12311 +note("\$Data::Dumper::Deepcopy and Deepcopy()"); |
|
12312 + |
|
12313 +{ |
|
12314 + my ($obj, %dumps, $deepcopy); |
|
12315 + |
|
12316 + # Adapted from example in Dumper.pm POD: |
|
12317 + @d = ('c'); |
|
12318 + $c = \@d; |
|
12319 + $b = {}; |
|
12320 + $a = [1, $b, $c]; |
|
12321 + $b->{a} = $a; |
|
12322 + $b->{b} = $a->[1]; |
|
12323 + $b->{c} = $a->[2]; |
|
12324 + |
|
12325 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12326 + $dumps{'noprev'} = _dumptostr($obj); |
|
12327 + |
|
12328 + $deepcopy = undef; |
|
12329 + local $Data::Dumper::Deepcopy = $deepcopy; |
|
12330 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12331 + $dumps{'dddundef'} = _dumptostr($obj); |
|
12332 + |
|
12333 + $deepcopy = 0; |
|
12334 + local $Data::Dumper::Deepcopy = $deepcopy; |
|
12335 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12336 + $dumps{'dddzero'} = _dumptostr($obj); |
|
12337 + |
|
12338 + is($dumps{'noprev'}, $dumps{'dddundef'}, |
|
12339 + "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = undef"); |
|
12340 + |
|
12341 + is($dumps{'noprev'}, $dumps{'dddzero'}, |
|
12342 + "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = 0"); |
|
12343 +} |
|
12344 + |
|
12345 +{ |
|
12346 + my ($obj, %dumps, $deepcopy); |
|
12347 + |
|
12348 + @d = ('c'); |
|
12349 + $c = \@d; |
|
12350 + $b = {}; |
|
12351 + $a = [1, $b, $c]; |
|
12352 + $b->{a} = $a; |
|
12353 + $b->{b} = $a->[1]; |
|
12354 + $b->{c} = $a->[2]; |
|
12355 + |
|
12356 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12357 + $dumps{'noprev'} = _dumptostr($obj); |
|
12358 + |
|
12359 + $deepcopy = 0; |
|
12360 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12361 + $obj->Deepcopy($deepcopy); |
|
12362 + $dumps{'objzero'} = _dumptostr($obj); |
|
12363 + |
|
12364 + is($dumps{'noprev'}, $dumps{'objzero'}, |
|
12365 + "No previous Deepcopy setting equivalent to Deepcopy(0)"); |
|
12366 + |
|
12367 + $deepcopy = undef; |
|
12368 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12369 + $obj->Deepcopy($deepcopy); |
|
12370 + $dumps{'objundef'} = _dumptostr($obj); |
|
12371 + |
|
12372 + is($dumps{'noprev'}, $dumps{'objundef'}, |
|
12373 + "No previous Deepcopy setting equivalent to Deepcopy(undef)"); |
|
12374 +} |
|
12375 + |
|
12376 +{ |
|
12377 + my ($obj, %dumps, $deepcopy); |
|
12378 + |
|
12379 + @d = ('c'); |
|
12380 + $c = \@d; |
|
12381 + $b = {}; |
|
12382 + $a = [1, $b, $c]; |
|
12383 + $b->{a} = $a; |
|
12384 + $b->{b} = $a->[1]; |
|
12385 + $b->{c} = $a->[2]; |
|
12386 + |
|
12387 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12388 + $dumps{'noprev'} = _dumptostr($obj); |
|
12389 + |
|
12390 + $deepcopy = 1; |
|
12391 + local $Data::Dumper::Deepcopy = $deepcopy; |
|
12392 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12393 + $dumps{'dddone'} = _dumptostr($obj); |
|
12394 + |
|
12395 + isnt($dumps{'noprev'}, $dumps{'dddone'}, |
|
12396 + "No previous Deepcopy setting different from \$Data::Dumper::Deepcopy = 1"); |
|
12397 +} |
|
12398 + |
|
12399 +{ |
|
12400 + my ($obj, %dumps, $deepcopy); |
|
12401 + |
|
12402 + @d = ('c'); |
|
12403 + $c = \@d; |
|
12404 + $b = {}; |
|
12405 + $a = [1, $b, $c]; |
|
12406 + $b->{a} = $a; |
|
12407 + $b->{b} = $a->[1]; |
|
12408 + $b->{c} = $a->[2]; |
|
12409 + |
|
12410 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12411 + $dumps{'noprev'} = _dumptostr($obj); |
|
12412 + |
|
12413 + $deepcopy = 1; |
|
12414 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12415 + $obj->Deepcopy(1); |
|
12416 + $dumps{'objone'} = _dumptostr($obj); |
|
12417 + |
|
12418 + isnt($dumps{'noprev'}, $dumps{'objone'}, |
|
12419 + "No previous Deepcopy setting different from Deepcopy(0)"); |
|
12420 +} |
|
12421 + |
|
12422 +{ |
|
12423 + my ($obj, %dumps, $deepcopy); |
|
12424 + |
|
12425 + @d = ('c'); |
|
12426 + $c = \@d; |
|
12427 + $b = {}; |
|
12428 + $a = [1, $b, $c]; |
|
12429 + $b->{a} = $a; |
|
12430 + $b->{b} = $a->[1]; |
|
12431 + $b->{c} = $a->[2]; |
|
12432 + |
|
12433 + $deepcopy = 1; |
|
12434 + local $Data::Dumper::Deepcopy = $deepcopy; |
|
12435 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12436 + $dumps{'dddone'} = _dumptostr($obj); |
|
12437 + local $Data::Dumper::Deepcopy = undef; |
|
12438 + |
|
12439 + $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]); |
|
12440 + $obj->Deepcopy(1); |
|
12441 + $dumps{'objone'} = _dumptostr($obj); |
|
12442 + |
|
12443 + is($dumps{'dddone'}, $dumps{'objone'}, |
|
12444 + "\$Data::Dumper::Deepcopy = 1 and Deepcopy(1) are equivalent"); |
|
12445 +} |
|
12446 + |
|
12447 +note("\$Data::Dumper::Maxdepth and Maxdepth()"); |
|
12448 + |
|
12449 +{ |
|
12450 + # Adapted from Dumper.pm POD |
|
12451 + |
|
12452 + my ($obj, %dumps, $maxdepth); |
|
12453 + |
|
12454 + $a = "pearl"; |
|
12455 + $b = [ $a ]; |
|
12456 + $c = { 'b' => $b }; |
|
12457 + $d = [ $c ]; |
|
12458 + $e = { 'd' => $d }; |
|
12459 + $f = { 'e' => $e }; |
|
12460 + |
|
12461 + note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef"); |
|
12462 + local $Data::Dumper::Useperl = 1; |
|
12463 + |
|
12464 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12465 + $dumps{'noprev'} = _dumptostr($obj); |
|
12466 + |
|
12467 + $Data::Dumper::Maxdepth = undef; |
|
12468 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12469 + $dumps{'ddmundef'} = _dumptostr($obj); |
|
12470 + |
|
12471 + $maxdepth = 3; |
|
12472 + local $Data::Dumper::Maxdepth = $maxdepth; |
|
12473 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12474 + $dumps{'ddm'} = _dumptostr($obj); |
|
12475 + |
|
12476 + is($dumps{'noprev'}, $dumps{'ddmundef'}, |
|
12477 + "No previous Maxdepth setting equivalent to \$Data::Dumper::Maxdepth = undef"); |
|
12478 + |
|
12479 + like($dumps{'noprev'}, qr/$a/s, |
|
12480 + "Without Maxdepth, got output from deepest level"); |
|
12481 + |
|
12482 + isnt($dumps{'noprev'}, $dumps{'ddm'}, |
|
12483 + "No previous Maxdepth setting differs from setting a shallow Maxdepth"); |
|
12484 + |
|
12485 + unlike($dumps{'ddm'}, qr/$a/s, |
|
12486 + "With Maxdepth, did not get output from deepest level"); |
|
12487 +} |
|
12488 + |
|
12489 +{ |
|
12490 + # Adapted from Dumper.pm POD |
|
12491 + |
|
12492 + my ($obj, %dumps, $maxdepth); |
|
12493 + |
|
12494 + $a = "pearl"; |
|
12495 + $b = [ $a ]; |
|
12496 + $c = { 'b' => $b }; |
|
12497 + $d = [ $c ]; |
|
12498 + $e = { 'd' => $d }; |
|
12499 + $f = { 'e' => $e }; |
|
12500 + |
|
12501 + note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef"); |
|
12502 + local $Data::Dumper::Useperl = 1; |
|
12503 + |
|
12504 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12505 + $dumps{'noprev'} = _dumptostr($obj); |
|
12506 + |
|
12507 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12508 + $obj->Maxdepth(); |
|
12509 + $dumps{'maxdepthempty'} = _dumptostr($obj); |
|
12510 + |
|
12511 + is($dumps{'noprev'}, $dumps{'maxdepthempty'}, |
|
12512 + "No previous Maxdepth setting equivalent to Maxdepth() with no argument"); |
|
12513 + |
|
12514 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12515 + $obj->Maxdepth(undef); |
|
12516 + $dumps{'maxdepthundef'} = _dumptostr($obj); |
|
12517 + |
|
12518 + is($dumps{'noprev'}, $dumps{'maxdepthundef'}, |
|
12519 + "No previous Maxdepth setting equivalent to Maxdepth(undef)"); |
|
12520 + |
|
12521 + $maxdepth = 3; |
|
12522 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12523 + $obj->Maxdepth($maxdepth); |
|
12524 + $dumps{'maxdepthset'} = _dumptostr($obj); |
|
12525 + |
|
12526 + isnt($dumps{'noprev'}, $dumps{'maxdepthset'}, |
|
12527 + "No previous Maxdepth setting differs from Maxdepth() with shallow depth"); |
|
12528 + |
|
12529 + local $Data::Dumper::Maxdepth = 3; |
|
12530 + $obj = Data::Dumper->new([$f], [qw(f)]); |
|
12531 + $dumps{'ddmset'} = _dumptostr($obj); |
|
12532 + |
|
12533 + is($dumps{'maxdepthset'}, $dumps{'ddmset'}, |
|
12534 + "Maxdepth set and \$Data::Dumper::Maxdepth are equivalent"); |
|
12535 +} |
|
12536 + |
|
12537 +{ |
|
12538 + my ($obj, %dumps); |
|
12539 + |
|
12540 + my $warning = ''; |
|
12541 + local $SIG{__WARN__} = sub { $warning = $_[0] }; |
|
12542 + |
|
12543 + local $Data::Dumper::Deparse = 0; |
|
12544 + local $Data::Dumper::Purity = 1; |
|
12545 + local $Data::Dumper::Useperl = 1; |
|
12546 + sub hello { print "Hello world\n"; } |
|
12547 + $obj = Data::Dumper->new( [ \&hello ] ); |
|
12548 + $dumps{'ddsksub'} = _dumptostr($obj); |
|
12549 + like($warning, qr/^Encountered CODE ref, using dummy placeholder/, |
|
12550 + "Got expected warning: dummy placeholder under Purity = 1"); |
|
12551 +} |
|
12552 + |
|
12553 +{ |
|
12554 + my ($obj, %dumps); |
|
12555 + |
|
12556 + my $warning = ''; |
|
12557 + local $SIG{__WARN__} = sub { $warning = $_[0] }; |
|
12558 + |
|
12559 + local $Data::Dumper::Deparse = 0; |
|
12560 + local $Data::Dumper::Useperl = 1; |
|
12561 + sub jello { print "Jello world\n"; } |
|
12562 + $obj = Data::Dumper->new( [ \&hello ] ); |
|
12563 + $dumps{'ddsksub'} = _dumptostr($obj); |
|
12564 + ok(! $warning, "Encountered CODE ref, but no Purity, hence no warning"); |
|
12565 +} |
|
12566 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/qr.t perl-5.12.5_dumper/dist/Data-Dumper/t/qr.t |
|
12567 --- perl-5.12.5/dist/Data-Dumper/t/qr.t 1969-12-31 19:00:00.000000000 -0500 |
|
12568 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/qr.t 2014-10-09 15:06:36.179661797 -0400 |
|
12569 @@ -0,0 +1,24 @@ |
|
12570 +#!perl -X |
|
12571 + |
|
12572 +BEGIN { |
|
12573 + require Config; import Config; |
|
12574 + no warnings 'once'; |
|
12575 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
12576 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
12577 + exit 0; |
|
12578 + } |
|
12579 +} |
|
12580 + |
|
12581 +use Test::More tests => 2; |
|
12582 +use Data::Dumper; |
|
12583 + |
|
12584 +{ |
|
12585 + my $q = q| \/ |; |
|
12586 + use Data::Dumper; |
|
12587 + my $qr = qr{$q}; |
|
12588 + eval Dumper $qr; |
|
12589 + ok(!$@, "Dumping $qr with XS") or diag $@, Dumper $qr; |
|
12590 + local $Data::Dumper::Useperl = 1; |
|
12591 + eval Dumper $qr; |
|
12592 + ok(!$@, "Dumping $qr with PP") or diag $@, Dumper $qr; |
|
12593 +} |
|
12594 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/quotekeys.t perl-5.12.5_dumper/dist/Data-Dumper/t/quotekeys.t |
|
12595 --- perl-5.12.5/dist/Data-Dumper/t/quotekeys.t 1969-12-31 19:00:00.000000000 -0500 |
|
12596 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/quotekeys.t 2014-10-09 15:06:36.178495322 -0400 |
|
12597 @@ -0,0 +1,135 @@ |
|
12598 +#!./perl -w |
|
12599 +# t/quotekeys.t - Test Quotekeys() |
|
12600 + |
|
12601 +BEGIN { |
|
12602 + if ($ENV{PERL_CORE}){ |
|
12603 + require Config; import Config; |
|
12604 + no warnings 'once'; |
|
12605 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
12606 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
12607 + exit 0; |
|
12608 + } |
|
12609 + } |
|
12610 +} |
|
12611 + |
|
12612 +use strict; |
|
12613 + |
|
12614 +use Data::Dumper; |
|
12615 +use Test::More tests => 18; |
|
12616 +use lib qw( ./t/lib ); |
|
12617 +use Testing qw( _dumptostr ); |
|
12618 + |
|
12619 +my %d = ( |
|
12620 + delta => 'd', |
|
12621 + beta => 'b', |
|
12622 + gamma => 'c', |
|
12623 + alpha => 'a', |
|
12624 +); |
|
12625 + |
|
12626 +run_tests_for_quotekeys(); |
|
12627 +SKIP: { |
|
12628 + skip "XS version was unavailable, so we already ran with pure Perl", 5 |
|
12629 + if $Data::Dumper::Useperl; |
|
12630 + local $Data::Dumper::Useperl = 1; |
|
12631 + run_tests_for_quotekeys(); |
|
12632 +} |
|
12633 + |
|
12634 +sub run_tests_for_quotekeys { |
|
12635 + note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl"); |
|
12636 + |
|
12637 + my ($obj, %dumps, $quotekeys, $starting); |
|
12638 + |
|
12639 + note("\$Data::Dumper::Quotekeys and Quotekeys() set to true value"); |
|
12640 + |
|
12641 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12642 + $dumps{'ddqkdefault'} = _dumptostr($obj); |
|
12643 + |
|
12644 + $starting = $Data::Dumper::Quotekeys; |
|
12645 + $quotekeys = 1; |
|
12646 + local $Data::Dumper::Quotekeys = $quotekeys; |
|
12647 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12648 + $dumps{'ddqkone'} = _dumptostr($obj); |
|
12649 + local $Data::Dumper::Quotekeys = $starting; |
|
12650 + |
|
12651 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12652 + $obj->Quotekeys($quotekeys); |
|
12653 + $dumps{'objqkone'} = _dumptostr($obj); |
|
12654 + |
|
12655 + is($dumps{'ddqkdefault'}, $dumps{'ddqkone'}, |
|
12656 + "\$Data::Dumper::Quotekeys = 1 is default"); |
|
12657 + is($dumps{'ddqkone'}, $dumps{'objqkone'}, |
|
12658 + "\$Data::Dumper::Quotekeys = 1 and Quotekeys(1) are equivalent"); |
|
12659 + %dumps = (); |
|
12660 + |
|
12661 + $quotekeys = 0; |
|
12662 + local $Data::Dumper::Quotekeys = $quotekeys; |
|
12663 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12664 + $dumps{'ddqkzero'} = _dumptostr($obj); |
|
12665 + local $Data::Dumper::Quotekeys = $starting; |
|
12666 + |
|
12667 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12668 + $obj->Quotekeys($quotekeys); |
|
12669 + $dumps{'objqkzero'} = _dumptostr($obj); |
|
12670 + |
|
12671 + is($dumps{'ddqkzero'}, $dumps{'objqkzero'}, |
|
12672 + "\$Data::Dumper::Quotekeys = 0 and Quotekeys(0) are equivalent"); |
|
12673 + |
|
12674 + $quotekeys = undef; |
|
12675 + local $Data::Dumper::Quotekeys = $quotekeys; |
|
12676 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12677 + $dumps{'ddqkundef'} = _dumptostr($obj); |
|
12678 + local $Data::Dumper::Quotekeys = $starting; |
|
12679 + |
|
12680 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12681 + $obj->Quotekeys($quotekeys); |
|
12682 + $dumps{'objqkundef'} = _dumptostr($obj); |
|
12683 + |
|
12684 + note("Quotekeys(undef) will fall back to the default value\nfor \$Data::Dumper::Quotekeys, which is a true value."); |
|
12685 + isnt($dumps{'ddqkundef'}, $dumps{'objqkundef'}, |
|
12686 + "\$Data::Dumper::Quotekeys = undef and Quotekeys(undef) are equivalent"); |
|
12687 + isnt($dumps{'ddqkzero'}, $dumps{'objqkundef'}, |
|
12688 + "\$Data::Dumper::Quotekeys = undef and = 0 are equivalent"); |
|
12689 + %dumps = (); |
|
12690 + |
|
12691 + local $Data::Dumper::Quotekeys = 1; |
|
12692 + local $Data::Dumper::Sortkeys = 1; |
|
12693 + local $Data::Dumper::Indent = 0; |
|
12694 + local $Data::Dumper::Useqq = 0; |
|
12695 + |
|
12696 + my %qkdata = |
|
12697 + ( |
|
12698 + 0 => 1, |
|
12699 + '012345' => 1, |
|
12700 + 12 => 1, |
|
12701 + 123456789 => 1, |
|
12702 + 1234567890 => 1, |
|
12703 + '::de::fg' => 1, |
|
12704 + ab => 1, |
|
12705 + 'hi::12' => 1, |
|
12706 + "1\x{660}" => 1, |
|
12707 + ); |
|
12708 + |
|
12709 + is(Dumper(\%qkdata), |
|
12710 + q($VAR1 = {'0' => 1,'012345' => 1,'12' => 1,'123456789' => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,'ab' => 1,'hi::12' => 1};), |
|
12711 + "always quote when quotekeys true"); |
|
12712 + |
|
12713 + { |
|
12714 + local $Data::Dumper::Useqq = 1; |
|
12715 + is(Dumper(\%qkdata), |
|
12716 + q($VAR1 = {"0" => 1,"012345" => 1,"12" => 1,"123456789" => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,"ab" => 1,"hi::12" => 1};), |
|
12717 + "always quote when quotekeys true (useqq)"); |
|
12718 + } |
|
12719 + |
|
12720 + local $Data::Dumper::Quotekeys = 0; |
|
12721 + |
|
12722 + is(Dumper(\%qkdata), |
|
12723 + q($VAR1 = {0 => 1,'012345' => 1,12 => 1,123456789 => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,ab => 1,'hi::12' => 1};), |
|
12724 + "avoid quotes when quotekeys false"); |
|
12725 + { |
|
12726 + local $Data::Dumper::Useqq = 1; |
|
12727 + is(Dumper(\%qkdata), |
|
12728 + q($VAR1 = {0 => 1,"012345" => 1,12 => 1,123456789 => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,ab => 1,"hi::12" => 1};), |
|
12729 + "avoid quotes when quotekeys false (useqq)"); |
|
12730 + } |
|
12731 +} |
|
12732 + |
|
12733 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/recurse.t perl-5.12.5_dumper/dist/Data-Dumper/t/recurse.t |
|
12734 --- perl-5.12.5/dist/Data-Dumper/t/recurse.t 1969-12-31 19:00:00.000000000 -0500 |
|
12735 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/recurse.t 2014-10-09 15:06:36.172817083 -0400 |
|
12736 @@ -0,0 +1,45 @@ |
|
12737 +#!perl |
|
12738 + |
|
12739 +# Test the Maxrecurse option |
|
12740 + |
|
12741 +use strict; |
|
12742 +use Test::More tests => 32; |
|
12743 +use Data::Dumper; |
|
12744 + |
|
12745 +SKIP: { |
|
12746 + skip "no XS available", 16 |
|
12747 + if $Data::Dumper::Useperl; |
|
12748 + local $Data::Dumper::Useperl = 1; |
|
12749 + test_recursion(); |
|
12750 +} |
|
12751 + |
|
12752 +test_recursion(); |
|
12753 + |
|
12754 +sub test_recursion { |
|
12755 + my $pp = $Data::Dumper::Useperl ? "pure perl" : "XS"; |
|
12756 + $Data::Dumper::Purity = 1; # make sure this has no effect |
|
12757 + $Data::Dumper::Indent = 0; |
|
12758 + $Data::Dumper::Maxrecurse = 1; |
|
12759 + is(eval { Dumper([]) }, '$VAR1 = [];', "$pp: maxrecurse 1, []"); |
|
12760 + is(eval { Dumper([[]]) }, undef, "$pp: maxrecurse 1, [[]]"); |
|
12761 + ok($@, "exception thrown"); |
|
12762 + is(eval { Dumper({}) }, '$VAR1 = {};', "$pp: maxrecurse 1, {}"); |
|
12763 + is(eval { Dumper({ a => 1 }) }, q($VAR1 = {'a' => 1};), |
|
12764 + "$pp: maxrecurse 1, { a => 1 }"); |
|
12765 + is(eval { Dumper({ a => {} }) }, undef, "$pp: maxrecurse 1, { a => {} }"); |
|
12766 + ok($@, "exception thrown"); |
|
12767 + is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 1, \\1"); |
|
12768 + is(eval { Dumper(\\1) }, undef, "$pp: maxrecurse 1, \\1"); |
|
12769 + ok($@, "exception thrown"); |
|
12770 + $Data::Dumper::Maxrecurse = 3; |
|
12771 + is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 3, \\1"); |
|
12772 + is(eval { Dumper(\(my $s = {})) }, "\$VAR1 = \\{};", "$pp: maxrecurse 3, \\{}"); |
|
12773 + is(eval { Dumper(\(my $s = { a => [] })) }, "\$VAR1 = \\{'a' => []};", |
|
12774 + "$pp: maxrecurse 3, \\{ a => [] }"); |
|
12775 + is(eval { Dumper(\(my $s = { a => [{}] })) }, undef, |
|
12776 + "$pp: maxrecurse 3, \\{ a => [{}] }"); |
|
12777 + ok($@, "exception thrown"); |
|
12778 + $Data::Dumper::Maxrecurse = 0; |
|
12779 + is(eval { Dumper([[[[[]]]]]) }, q($VAR1 = [[[[[]]]]];), |
|
12780 + "$pp: check Maxrecurse doesn't set limit to 0 recursion"); |
|
12781 +} |
|
12782 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/seen.t perl-5.12.5_dumper/dist/Data-Dumper/t/seen.t |
|
12783 --- perl-5.12.5/dist/Data-Dumper/t/seen.t 1969-12-31 19:00:00.000000000 -0500 |
|
12784 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/seen.t 2014-10-09 15:06:36.179175807 -0400 |
|
12785 @@ -0,0 +1,103 @@ |
|
12786 +#!./perl -w |
|
12787 +# t/seen.t - Test Seen() |
|
12788 + |
|
12789 +BEGIN { |
|
12790 + if ($ENV{PERL_CORE}){ |
|
12791 + require Config; import Config; |
|
12792 + no warnings 'once'; |
|
12793 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
12794 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
12795 + exit 0; |
|
12796 + } |
|
12797 + } |
|
12798 +} |
|
12799 + |
|
12800 +use strict; |
|
12801 + |
|
12802 +use Data::Dumper; |
|
12803 +use Test::More tests => 10; |
|
12804 +use lib qw( ./t/lib ); |
|
12805 +use Testing qw( _dumptostr ); |
|
12806 + |
|
12807 +my ($obj, %dumps); |
|
12808 + |
|
12809 +my (@e, %f, @rv, @g, %h, $k); |
|
12810 +@e = ( qw| alpha beta gamma | ); |
|
12811 +%f = ( epsilon => 'zeta', eta => 'theta' ); |
|
12812 +@g = ( qw| iota kappa lambda | ); |
|
12813 +%h = ( mu => 'nu', omicron => 'pi' ); |
|
12814 +sub j { print "Hello world\n"; } |
|
12815 +$k = 'just another scalar'; |
|
12816 + |
|
12817 +{ |
|
12818 + my $warning = ''; |
|
12819 + local $SIG{__WARN__} = sub { $warning = $_[0] }; |
|
12820 + |
|
12821 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12822 + @rv = $obj->Seen( { mark => 'snark' } ); |
|
12823 + like($warning, |
|
12824 + qr/^Only refs supported, ignoring non-ref item \$mark/, |
|
12825 + "Got expected warning for non-ref item"); |
|
12826 +} |
|
12827 + |
|
12828 +{ |
|
12829 + my $warning = ''; |
|
12830 + local $SIG{__WARN__} = sub { $warning = $_[0] }; |
|
12831 + |
|
12832 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12833 + @rv = $obj->Seen( { mark => undef } ); |
|
12834 + like($warning, |
|
12835 + qr/^Value of ref must be defined; ignoring undefined item \$mark/, |
|
12836 + "Got expected warning for undefined value of item"); |
|
12837 +} |
|
12838 + |
|
12839 +{ |
|
12840 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12841 + @rv = $obj->Seen( undef ); |
|
12842 + is(@rv, 0, "Seen(undef) returned empty array"); |
|
12843 +} |
|
12844 + |
|
12845 +{ |
|
12846 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12847 + @rv = $obj->Seen( [ qw| mark snark | ] ); |
|
12848 + is(@rv, 0, "Seen(ref other than hashref) returned empty array"); |
|
12849 +} |
|
12850 + |
|
12851 +{ |
|
12852 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12853 + @rv = $obj->Seen( { '*samba' => \@g } ); |
|
12854 + is_deeply($rv[0], $obj, "Got the object back: value array ref"); |
|
12855 +} |
|
12856 + |
|
12857 +{ |
|
12858 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12859 + @rv = $obj->Seen( { '*canasta' => \%h } ); |
|
12860 + is_deeply($rv[0], $obj, "Got the object back: value hash ref"); |
|
12861 +} |
|
12862 + |
|
12863 +{ |
|
12864 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12865 + @rv = $obj->Seen( { '*pinochle' => \&j } ); |
|
12866 + is_deeply($rv[0], $obj, "Got the object back: value code ref"); |
|
12867 +} |
|
12868 + |
|
12869 +{ |
|
12870 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12871 + @rv = $obj->Seen( { '*poker' => \$k } ); |
|
12872 + is_deeply($rv[0], $obj, "Got the object back: value ref to scalar"); |
|
12873 +} |
|
12874 + |
|
12875 +{ |
|
12876 + my $l = 'loo'; |
|
12877 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12878 + @rv = $obj->Seen( { $l => \$k } ); |
|
12879 + is_deeply($rv[0], $obj, "Got the object back: value ref to scalar"); |
|
12880 +} |
|
12881 + |
|
12882 +{ |
|
12883 + my $l = '$loo'; |
|
12884 + $obj = Data::Dumper->new( [ \@e, \%f ]); |
|
12885 + @rv = $obj->Seen( { $l => \$k } ); |
|
12886 + is_deeply($rv[0], $obj, "Got the object back: value ref to scalar"); |
|
12887 +} |
|
12888 + |
|
12889 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/sortkeys.t perl-5.12.5_dumper/dist/Data-Dumper/t/sortkeys.t |
|
12890 --- perl-5.12.5/dist/Data-Dumper/t/sortkeys.t 1969-12-31 19:00:00.000000000 -0500 |
|
12891 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/sortkeys.t 2014-10-09 15:06:36.174321223 -0400 |
|
12892 @@ -0,0 +1,190 @@ |
|
12893 +#!./perl -w |
|
12894 +# t/sortkeys.t - Test Sortkeys() |
|
12895 + |
|
12896 +BEGIN { |
|
12897 + if ($ENV{PERL_CORE}){ |
|
12898 + require Config; import Config; |
|
12899 + no warnings 'once'; |
|
12900 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
12901 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
12902 + exit 0; |
|
12903 + } |
|
12904 + } |
|
12905 +} |
|
12906 + |
|
12907 +use strict; |
|
12908 + |
|
12909 +use Data::Dumper; |
|
12910 +use Test::More tests => 26; |
|
12911 +use lib qw( ./t/lib ); |
|
12912 +use Testing qw( _dumptostr ); |
|
12913 + |
|
12914 +run_tests_for_sortkeys(); |
|
12915 +SKIP: { |
|
12916 + skip "XS version was unavailable, so we already ran with pure Perl", 13 |
|
12917 + if $Data::Dumper::Useperl; |
|
12918 + local $Data::Dumper::Useperl = 1; |
|
12919 + run_tests_for_sortkeys(); |
|
12920 +} |
|
12921 + |
|
12922 +sub run_tests_for_sortkeys { |
|
12923 + note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl"); |
|
12924 + |
|
12925 + my %d = ( |
|
12926 + delta => 'd', |
|
12927 + beta => 'b', |
|
12928 + gamma => 'c', |
|
12929 + alpha => 'a', |
|
12930 + ); |
|
12931 + |
|
12932 + { |
|
12933 + my ($obj, %dumps, $sortkeys, $starting); |
|
12934 + |
|
12935 + note("\$Data::Dumper::Sortkeys and Sortkeys() set to true value"); |
|
12936 + |
|
12937 + $starting = $Data::Dumper::Sortkeys; |
|
12938 + $sortkeys = 1; |
|
12939 + local $Data::Dumper::Sortkeys = $sortkeys; |
|
12940 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12941 + $dumps{'ddskone'} = _dumptostr($obj); |
|
12942 + local $Data::Dumper::Sortkeys = $starting; |
|
12943 + |
|
12944 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12945 + $obj->Sortkeys($sortkeys); |
|
12946 + $dumps{'objskone'} = _dumptostr($obj); |
|
12947 + |
|
12948 + is($dumps{'ddskone'}, $dumps{'objskone'}, |
|
12949 + "\$Data::Dumper::Sortkeys = 1 and Sortkeys(1) are equivalent"); |
|
12950 + like($dumps{'ddskone'}, |
|
12951 + qr/alpha.*?beta.*?delta.*?gamma/s, |
|
12952 + "Sortkeys returned hash keys in Perl's default sort order"); |
|
12953 + %dumps = (); |
|
12954 + |
|
12955 + } |
|
12956 + |
|
12957 + { |
|
12958 + my ($obj, %dumps, $starting); |
|
12959 + |
|
12960 + note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef"); |
|
12961 + |
|
12962 + $starting = $Data::Dumper::Sortkeys; |
|
12963 + local $Data::Dumper::Sortkeys = \&reversekeys; |
|
12964 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12965 + $dumps{'ddsksub'} = _dumptostr($obj); |
|
12966 + local $Data::Dumper::Sortkeys = $starting; |
|
12967 + |
|
12968 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12969 + $obj->Sortkeys(\&reversekeys); |
|
12970 + $dumps{'objsksub'} = _dumptostr($obj); |
|
12971 + |
|
12972 + is($dumps{'ddsksub'}, $dumps{'objsksub'}, |
|
12973 + "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) are equivalent"); |
|
12974 + like($dumps{'ddsksub'}, |
|
12975 + qr/gamma.*?delta.*?beta.*?alpha/s, |
|
12976 + "Sortkeys returned hash keys per sorting subroutine"); |
|
12977 + %dumps = (); |
|
12978 + |
|
12979 + } |
|
12980 + |
|
12981 + { |
|
12982 + my ($obj, %dumps, $starting); |
|
12983 + |
|
12984 + note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef with filter"); |
|
12985 + $starting = $Data::Dumper::Sortkeys; |
|
12986 + local $Data::Dumper::Sortkeys = \&reversekeystrim; |
|
12987 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12988 + $dumps{'ddsksub'} = _dumptostr($obj); |
|
12989 + local $Data::Dumper::Sortkeys = $starting; |
|
12990 + |
|
12991 + $obj = Data::Dumper->new( [ \%d ] ); |
|
12992 + $obj->Sortkeys(\&reversekeystrim); |
|
12993 + $dumps{'objsksub'} = _dumptostr($obj); |
|
12994 + |
|
12995 + is($dumps{'ddsksub'}, $dumps{'objsksub'}, |
|
12996 + "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) select same keys"); |
|
12997 + like($dumps{'ddsksub'}, |
|
12998 + qr/gamma.*?delta.*?beta/s, |
|
12999 + "Sortkeys returned hash keys per sorting subroutine"); |
|
13000 + unlike($dumps{'ddsksub'}, |
|
13001 + qr/alpha/s, |
|
13002 + "Sortkeys filtered out one key per request"); |
|
13003 + %dumps = (); |
|
13004 + |
|
13005 + } |
|
13006 + |
|
13007 + { |
|
13008 + my ($obj, %dumps, $sortkeys, $starting); |
|
13009 + |
|
13010 + note("\$Data::Dumper::Sortkeys(undef) and Sortkeys(undef)"); |
|
13011 + |
|
13012 + $starting = $Data::Dumper::Sortkeys; |
|
13013 + $sortkeys = 0; |
|
13014 + local $Data::Dumper::Sortkeys = $sortkeys; |
|
13015 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13016 + $dumps{'ddskzero'} = _dumptostr($obj); |
|
13017 + local $Data::Dumper::Sortkeys = $starting; |
|
13018 + |
|
13019 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13020 + $obj->Sortkeys($sortkeys); |
|
13021 + $dumps{'objskzero'} = _dumptostr($obj); |
|
13022 + |
|
13023 + $sortkeys = undef; |
|
13024 + local $Data::Dumper::Sortkeys = $sortkeys; |
|
13025 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13026 + $dumps{'ddskundef'} = _dumptostr($obj); |
|
13027 + local $Data::Dumper::Sortkeys = $starting; |
|
13028 + |
|
13029 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13030 + $obj->Sortkeys($sortkeys); |
|
13031 + $dumps{'objskundef'} = _dumptostr($obj); |
|
13032 + |
|
13033 + is($dumps{'ddskzero'}, $dumps{'objskzero'}, |
|
13034 + "\$Data::Dumper::Sortkeys = 0 and Sortkeys(0) are equivalent"); |
|
13035 + is($dumps{'ddskzero'}, $dumps{'ddskundef'}, |
|
13036 + "\$Data::Dumper::Sortkeys = 0 and = undef equivalent"); |
|
13037 + is($dumps{'objkzero'}, $dumps{'objkundef'}, |
|
13038 + "Sortkeys(0) and Sortkeys(undef) are equivalent"); |
|
13039 + %dumps = (); |
|
13040 + |
|
13041 + } |
|
13042 + |
|
13043 + note("Internal subroutine _sortkeys"); |
|
13044 + my %e = ( |
|
13045 + nu => 'n', |
|
13046 + lambda => 'l', |
|
13047 + kappa => 'k', |
|
13048 + mu => 'm', |
|
13049 + omicron => 'o', |
|
13050 + ); |
|
13051 + my $rv = Data::Dumper::_sortkeys(\%e); |
|
13052 + is(ref($rv), 'ARRAY', "Data::Dumper::_sortkeys returned an array ref"); |
|
13053 + is_deeply($rv, [ qw( kappa lambda mu nu omicron ) ], |
|
13054 + "Got keys in Perl default order"); |
|
13055 + { |
|
13056 + my $warning = ''; |
|
13057 + local $SIG{__WARN__} = sub { $warning = $_[0] }; |
|
13058 + |
|
13059 + my ($obj, %dumps, $starting); |
|
13060 + |
|
13061 + note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef"); |
|
13062 + |
|
13063 + $starting = $Data::Dumper::Sortkeys; |
|
13064 + local $Data::Dumper::Sortkeys = \&badreturnvalue; |
|
13065 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13066 + $dumps{'ddsksub'} = _dumptostr($obj); |
|
13067 + like($warning, qr/^Sortkeys subroutine did not return ARRAYREF/, |
|
13068 + "Got expected warning: sorting routine did not return array ref"); |
|
13069 + } |
|
13070 + |
|
13071 +} |
|
13072 + |
|
13073 +sub reversekeys { return [ reverse sort keys %{+shift} ]; } |
|
13074 + |
|
13075 +sub reversekeystrim { |
|
13076 + my $hr = shift; |
|
13077 + my @keys = sort keys %{$hr}; |
|
13078 + shift(@keys); |
|
13079 + return [ reverse @keys ]; |
|
13080 +} |
|
13081 + |
|
13082 +sub badreturnvalue { return { %{+shift} }; } |
|
13083 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/sparseseen.t perl-5.12.5_dumper/dist/Data-Dumper/t/sparseseen.t |
|
13084 --- perl-5.12.5/dist/Data-Dumper/t/sparseseen.t 1969-12-31 19:00:00.000000000 -0500 |
|
13085 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/sparseseen.t 2014-10-09 15:06:36.176307692 -0400 |
|
13086 @@ -0,0 +1,88 @@ |
|
13087 +#!./perl -w |
|
13088 +# t/sparseseen.t - Test Sparseseen() |
|
13089 + |
|
13090 +BEGIN { |
|
13091 + if ($ENV{PERL_CORE}){ |
|
13092 + require Config; import Config; |
|
13093 + no warnings 'once'; |
|
13094 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
13095 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
13096 + exit 0; |
|
13097 + } |
|
13098 + } |
|
13099 +} |
|
13100 + |
|
13101 +use strict; |
|
13102 + |
|
13103 +use Data::Dumper; |
|
13104 +use Test::More tests => 8; |
|
13105 +use lib qw( ./t/lib ); |
|
13106 +use Testing qw( _dumptostr ); |
|
13107 + |
|
13108 +my %d = ( |
|
13109 + delta => 'd', |
|
13110 + beta => 'b', |
|
13111 + gamma => 'c', |
|
13112 + alpha => 'a', |
|
13113 +); |
|
13114 + |
|
13115 +run_tests_for_sparseseen(); |
|
13116 +SKIP: { |
|
13117 + skip "XS version was unavailable, so we already ran with pure Perl", 4 |
|
13118 + if $Data::Dumper::Useperl; |
|
13119 + local $Data::Dumper::Useperl = 1; |
|
13120 + run_tests_for_sparseseen(); |
|
13121 +} |
|
13122 + |
|
13123 +sub run_tests_for_sparseseen { |
|
13124 + note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl"); |
|
13125 + |
|
13126 + my ($obj, %dumps, $sparseseen, $starting); |
|
13127 + |
|
13128 + note("\$Data::Dumper::Sparseseen and Sparseseen() set to true value"); |
|
13129 + |
|
13130 + $starting = $Data::Dumper::Sparseseen; |
|
13131 + $sparseseen = 1; |
|
13132 + local $Data::Dumper::Sparseseen = $sparseseen; |
|
13133 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13134 + $dumps{'ddssone'} = _dumptostr($obj); |
|
13135 + local $Data::Dumper::Sparseseen = $starting; |
|
13136 + |
|
13137 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13138 + $obj->Sparseseen($sparseseen); |
|
13139 + $dumps{'objssone'} = _dumptostr($obj); |
|
13140 + |
|
13141 + is($dumps{'ddssone'}, $dumps{'objssone'}, |
|
13142 + "\$Data::Dumper::Sparseseen = 1 and Sparseseen(1) are equivalent"); |
|
13143 + %dumps = (); |
|
13144 + |
|
13145 + $sparseseen = 0; |
|
13146 + local $Data::Dumper::Sparseseen = $sparseseen; |
|
13147 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13148 + $dumps{'ddsszero'} = _dumptostr($obj); |
|
13149 + local $Data::Dumper::Sparseseen = $starting; |
|
13150 + |
|
13151 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13152 + $obj->Sparseseen($sparseseen); |
|
13153 + $dumps{'objsszero'} = _dumptostr($obj); |
|
13154 + |
|
13155 + is($dumps{'ddsszero'}, $dumps{'objsszero'}, |
|
13156 + "\$Data::Dumper::Sparseseen = 0 and Sparseseen(0) are equivalent"); |
|
13157 + |
|
13158 + $sparseseen = undef; |
|
13159 + local $Data::Dumper::Sparseseen = $sparseseen; |
|
13160 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13161 + $dumps{'ddssundef'} = _dumptostr($obj); |
|
13162 + local $Data::Dumper::Sparseseen = $starting; |
|
13163 + |
|
13164 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13165 + $obj->Sparseseen($sparseseen); |
|
13166 + $dumps{'objssundef'} = _dumptostr($obj); |
|
13167 + |
|
13168 + is($dumps{'ddssundef'}, $dumps{'objssundef'}, |
|
13169 + "\$Data::Dumper::Sparseseen = undef and Sparseseen(undef) are equivalent"); |
|
13170 + is($dumps{'ddsszero'}, $dumps{'objssundef'}, |
|
13171 + "\$Data::Dumper::Sparseseen = undef and = 0 are equivalent"); |
|
13172 + %dumps = (); |
|
13173 +} |
|
13174 + |
|
13175 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/terse.t perl-5.12.5_dumper/dist/Data-Dumper/t/terse.t |
|
13176 --- perl-5.12.5/dist/Data-Dumper/t/terse.t 1969-12-31 19:00:00.000000000 -0500 |
|
13177 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/terse.t 2014-10-09 15:06:36.177303482 -0400 |
|
13178 @@ -0,0 +1,61 @@ |
|
13179 +#!perl |
|
13180 +use strict; |
|
13181 +use warnings; |
|
13182 + |
|
13183 +use Data::Dumper; |
|
13184 +use Test::More tests => 6; |
|
13185 +use lib qw( ./t/lib ); |
|
13186 +use Testing qw( _dumptostr ); |
|
13187 + |
|
13188 + |
|
13189 +my $hash = { foo => 42 }; |
|
13190 + |
|
13191 +for my $useperl (0..1) { |
|
13192 + my $dumper = Data::Dumper->new([$hash]); |
|
13193 + $dumper->Terse(1); |
|
13194 + $dumper->Indent(2); |
|
13195 + $dumper->Useperl($useperl); |
|
13196 + |
|
13197 + is $dumper->Dump, <<'WANT', "Terse(1), Indent(2), Useperl($useperl)"; |
|
13198 +{ |
|
13199 + 'foo' => 42 |
|
13200 +} |
|
13201 +WANT |
|
13202 +} |
|
13203 + |
|
13204 +my (%dumpstr); |
|
13205 +my $dumper; |
|
13206 + |
|
13207 +$dumper = Data::Dumper->new([$hash]); |
|
13208 +$dumpstr{noterse} = _dumptostr($dumper); |
|
13209 +# $VAR1 = { |
|
13210 +# 'foo' => 42 |
|
13211 +# }; |
|
13212 + |
|
13213 +$dumper = Data::Dumper->new([$hash]); |
|
13214 +$dumper->Terse(); |
|
13215 +$dumpstr{terse_no_arg} = _dumptostr($dumper); |
|
13216 + |
|
13217 +$dumper = Data::Dumper->new([$hash]); |
|
13218 +$dumper->Terse(0); |
|
13219 +$dumpstr{terse_0} = _dumptostr($dumper); |
|
13220 + |
|
13221 +$dumper = Data::Dumper->new([$hash]); |
|
13222 +$dumper->Terse(1); |
|
13223 +$dumpstr{terse_1} = _dumptostr($dumper); |
|
13224 +# { |
|
13225 +# 'foo' => 42 |
|
13226 +# } |
|
13227 + |
|
13228 +$dumper = Data::Dumper->new([$hash]); |
|
13229 +$dumper->Terse(undef); |
|
13230 +$dumpstr{terse_undef} = _dumptostr($dumper); |
|
13231 + |
|
13232 +is($dumpstr{noterse}, $dumpstr{terse_no_arg}, |
|
13233 + "absence of Terse is same as Terse()"); |
|
13234 +is($dumpstr{noterse}, $dumpstr{terse_0}, |
|
13235 + "absence of Terse is same as Terse(0)"); |
|
13236 +isnt($dumpstr{noterse}, $dumpstr{terse_1}, |
|
13237 + "absence of Terse is different from Terse(1)"); |
|
13238 +is($dumpstr{noterse}, $dumpstr{terse_undef}, |
|
13239 + "absence of Terse is same as Terse(undef)"); |
|
13240 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/toaster.t perl-5.12.5_dumper/dist/Data-Dumper/t/toaster.t |
|
13241 --- perl-5.12.5/dist/Data-Dumper/t/toaster.t 1969-12-31 19:00:00.000000000 -0500 |
|
13242 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/toaster.t 2014-10-09 15:06:36.180160759 -0400 |
|
13243 @@ -0,0 +1,88 @@ |
|
13244 +#!./perl -w |
|
13245 +# t/toaster.t - Test Toaster() |
|
13246 + |
|
13247 +BEGIN { |
|
13248 + if ($ENV{PERL_CORE}){ |
|
13249 + require Config; import Config; |
|
13250 + no warnings 'once'; |
|
13251 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
13252 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
13253 + exit 0; |
|
13254 + } |
|
13255 + } |
|
13256 +} |
|
13257 + |
|
13258 +use strict; |
|
13259 + |
|
13260 +use Data::Dumper; |
|
13261 +use Test::More tests => 8; |
|
13262 +use lib qw( ./t/lib ); |
|
13263 +use Testing qw( _dumptostr ); |
|
13264 + |
|
13265 +my %d = ( |
|
13266 + delta => 'd', |
|
13267 + beta => 'b', |
|
13268 + gamma => 'c', |
|
13269 + alpha => 'a', |
|
13270 +); |
|
13271 + |
|
13272 +run_tests_for_toaster(); |
|
13273 +SKIP: { |
|
13274 + skip "XS version was unavailable, so we already ran with pure Perl", 4 |
|
13275 + if $Data::Dumper::Useperl; |
|
13276 + local $Data::Dumper::Useperl = 1; |
|
13277 + run_tests_for_toaster(); |
|
13278 +} |
|
13279 + |
|
13280 +sub run_tests_for_toaster { |
|
13281 + note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl"); |
|
13282 + |
|
13283 + my ($obj, %dumps, $toaster, $starting); |
|
13284 + |
|
13285 + note("\$Data::Dumper::Toaster and Toaster() set to true value"); |
|
13286 + |
|
13287 + $starting = $Data::Dumper::Toaster; |
|
13288 + $toaster = 1; |
|
13289 + local $Data::Dumper::Toaster = $toaster; |
|
13290 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13291 + $dumps{'ddtoasterone'} = _dumptostr($obj); |
|
13292 + local $Data::Dumper::Toaster = $starting; |
|
13293 + |
|
13294 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13295 + $obj->Toaster($toaster); |
|
13296 + $dumps{'objtoasterone'} = _dumptostr($obj); |
|
13297 + |
|
13298 + is($dumps{'ddtoasterone'}, $dumps{'objtoasterone'}, |
|
13299 + "\$Data::Dumper::Toaster = 1 and Toaster(1) are equivalent"); |
|
13300 + %dumps = (); |
|
13301 + |
|
13302 + $toaster = 0; |
|
13303 + local $Data::Dumper::Toaster = $toaster; |
|
13304 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13305 + $dumps{'ddtoasterzero'} = _dumptostr($obj); |
|
13306 + local $Data::Dumper::Toaster = $starting; |
|
13307 + |
|
13308 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13309 + $obj->Toaster($toaster); |
|
13310 + $dumps{'objtoasterzero'} = _dumptostr($obj); |
|
13311 + |
|
13312 + is($dumps{'ddtoasterzero'}, $dumps{'objtoasterzero'}, |
|
13313 + "\$Data::Dumper::Toaster = 0 and Toaster(0) are equivalent"); |
|
13314 + |
|
13315 + $toaster = undef; |
|
13316 + local $Data::Dumper::Toaster = $toaster; |
|
13317 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13318 + $dumps{'ddtoasterundef'} = _dumptostr($obj); |
|
13319 + local $Data::Dumper::Toaster = $starting; |
|
13320 + |
|
13321 + $obj = Data::Dumper->new( [ \%d ] ); |
|
13322 + $obj->Toaster($toaster); |
|
13323 + $dumps{'objtoasterundef'} = _dumptostr($obj); |
|
13324 + |
|
13325 + is($dumps{'ddtoasterundef'}, $dumps{'objtoasterundef'}, |
|
13326 + "\$Data::Dumper::Toaster = undef and Toaster(undef) are equivalent"); |
|
13327 + is($dumps{'ddtoasterzero'}, $dumps{'objtoasterundef'}, |
|
13328 + "\$Data::Dumper::Toaster = undef and = 0 are equivalent"); |
|
13329 + %dumps = (); |
|
13330 +} |
|
13331 + |
|
13332 diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/values.t perl-5.12.5_dumper/dist/Data-Dumper/t/values.t |
|
13333 --- perl-5.12.5/dist/Data-Dumper/t/values.t 1969-12-31 19:00:00.000000000 -0500 |
|
13334 +++ perl-5.12.5_dumper/dist/Data-Dumper/t/values.t 2014-10-09 15:06:36.178013829 -0400 |
|
13335 @@ -0,0 +1,40 @@ |
|
13336 +#!./perl -w |
|
13337 + |
|
13338 +BEGIN { |
|
13339 + if ($ENV{PERL_CORE}){ |
|
13340 + require Config; import Config; |
|
13341 + no warnings 'once'; |
|
13342 + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { |
|
13343 + print "1..0 # Skip: Data::Dumper was not built\n"; |
|
13344 + exit 0; |
|
13345 + } |
|
13346 + } |
|
13347 +} |
|
13348 + |
|
13349 +use strict; |
|
13350 +use Data::Dumper; |
|
13351 +use Test::More tests => 4; |
|
13352 + |
|
13353 +my ($a, $b, $obj); |
|
13354 +my (@values, @names); |
|
13355 +my (@newvalues, $objagain, %newvalues); |
|
13356 +$a = 'alpha'; |
|
13357 +$b = 'beta'; |
|
13358 + |
|
13359 +$obj = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
13360 +@values = $obj->Values; |
|
13361 +is_deeply(\@values, [$a,$b], "Values() returned expected list"); |
|
13362 + |
|
13363 +@newvalues = ( qw| gamma delta epsilon | ); |
|
13364 +$objagain = $obj->Values(\@newvalues); |
|
13365 +is($objagain, $obj, "Values returned same object"); |
|
13366 +is_deeply($objagain->{todump}, \@newvalues, |
|
13367 + "Able to use Values() to set values to be dumped"); |
|
13368 + |
|
13369 +$obj = Data::Dumper->new([$a,$b], [qw(a b)]); |
|
13370 +%newvalues = ( gamma => 'delta', epsilon => 'zeta' ); |
|
13371 +eval { @values = $obj->Values(\%newvalues); }; |
|
13372 +like($@, qr/Argument to Values, if provided, must be array ref/, |
|
13373 + "Got expected error message: bad argument to Values()"); |
|
13374 + |
|
13375 + |
|
13376 diff -ur --new-file perl-5.12.5/ext/B/t/concise-xs.t perl-5.12.5_dumper/ext/B/t/concise-xs.t |
|
13377 --- perl-5.12.5/ext/B/t/concise-xs.t 2012-11-03 19:26:00.000000000 -0400 |
|
13378 +++ perl-5.12.5_dumper/ext/B/t/concise-xs.t 2014-10-09 14:41:00.586972981 -0400 |
|
13379 @@ -127,7 +127,8 @@ |
|
13380 Digest::MD5 => { perl => [qw/ import /], |
|
13381 dflt => 'XS' }, |
|
13382 |
|
13383 - Data::Dumper => { XS => [qw/ bootstrap Dumpxs /], |
|
13384 + Data::Dumper => { XS => [qw/ bootstrap Dumpxs _vstring /], |
|
13385 + constant => ['_bad_vsmg'], |
|
13386 dflt => 'perl' }, |
|
13387 B => { |
|
13388 dflt => 'constant', # all but 47/297 |
|
13389 diff -ur --new-file perl-5.12.5/MANIFEST perl-5.12.5_dumper/MANIFEST |
|
13390 --- perl-5.12.5/MANIFEST 2012-11-03 19:25:58.000000000 -0400 |
|
13391 +++ perl-5.12.5_dumper/MANIFEST 2014-10-09 14:42:04.829633708 -0400 |
|
13392 @@ -2602,13 +2602,37 @@ |
|
13393 dist/Data-Dumper/Changes Data pretty printer, changelog |
|
13394 dist/Data-Dumper/Dumper.pm Data pretty printer, module |
|
13395 dist/Data-Dumper/Dumper.xs Data pretty printer, externals |
|
13396 +dist/Data-Dumper/Makefile.PL |
|
13397 +dist/Data-Dumper/MANIFEST This list of files |
|
13398 +dist/Data-Dumper/MANIFEST.SKIP |
|
13399 +dist/Data-Dumper/META.yml Module meta-data (added by MakeMaker) |
|
13400 +dist/Data-Dumper/ppport.h |
|
13401 dist/Data-Dumper/t/bless.t See if Data::Dumper works |
|
13402 +dist/Data-Dumper/t/bless_var_method.t |
|
13403 dist/Data-Dumper/t/bugs.t See if Data::Dumper works |
|
13404 +dist/Data-Dumper/t/deparse.t |
|
13405 dist/Data-Dumper/t/dumper.t See if Data::Dumper works |
|
13406 +dist/Data-Dumper/t/dumpperl.t |
|
13407 dist/Data-Dumper/t/freezer.t See if $Data::Dumper::Freezer works |
|
13408 +dist/Data-Dumper/t/freezer_useperl.t |
|
13409 +dist/Data-Dumper/t/indent.t |
|
13410 +dist/Data-Dumper/t/lib/Testing.pm |
|
13411 +dist/Data-Dumper/t/misc.t |
|
13412 +dist/Data-Dumper/t/names.t |
|
13413 dist/Data-Dumper/Todo Data pretty printer, futures |
|
13414 dist/Data-Dumper/t/overload.t See if Data::Dumper works for overloaded data |
|
13415 dist/Data-Dumper/t/pair.t See if Data::Dumper pair separator works |
|
13416 +dist/Data-Dumper/t/perl-74170.t |
|
13417 +dist/Data-Dumper/t/purity_deepcopy_maxdepth.t |
|
13418 +dist/Data-Dumper/t/qr.t |
|
13419 +dist/Data-Dumper/t/quotekeys.t |
|
13420 +dist/Data-Dumper/t/recurse.t |
|
13421 +dist/Data-Dumper/t/seen.t |
|
13422 +dist/Data-Dumper/t/sortkeys.t |
|
13423 +dist/Data-Dumper/t/sparseseen.t |
|
13424 +dist/Data-Dumper/t/terse.t |
|
13425 +dist/Data-Dumper/t/toaster.t |
|
13426 +dist/Data-Dumper/t/values.t |
|
13427 dist/ExtUtils-Install/Changes ExtUtils-Install change log |
|
13428 dist/ExtUtils-Install/lib/ExtUtils/Installed.pm Information on installed extensions |
|
13429 dist/ExtUtils-Install/lib/ExtUtils/Install.pm Handles 'make install' on extensions |