Bug Summary

File:obj/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.c
Warning:line 682, column 13
Value stored to 'i' is never read

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple amd64-unknown-openbsd7.0 -analyze -disable-free -disable-llvm-verifier -discard-value-names -main-file-name Dumper.c -analyzer-store=region -analyzer-opt-analyze-nested-blocks -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -mrelocation-model pic -pic-level 1 -fhalf-no-semantic-interposition -fno-delete-null-pointer-checks -mframe-pointer=all -relaxed-aliasing -fno-rounding-math -mconstructor-aliases -munwind-tables -target-cpu x86-64 -target-feature +retpoline-indirect-calls -target-feature +retpoline-indirect-branches -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/usr/obj/gnu/usr.bin/perl/dist/Data-Dumper -resource-dir /usr/local/lib/clang/13.0.0 -D NO_LOCALE_NUMERIC -D NO_LOCALE_COLLATE -D VERSION="2.174_01" -D XS_VERSION="2.174_01" -D PIC -I ../.. -internal-isystem /usr/local/lib/clang/13.0.0/include -internal-externc-isystem /usr/include -O2 -Wwrite-strings -fconst-strings -fdebug-compilation-dir=/usr/obj/gnu/usr.bin/perl/dist/Data-Dumper -ferror-limit 19 -fwrapv -D_RET_PROTECTOR -ret-protector -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -fno-builtin-malloc -fno-builtin-calloc -fno-builtin-realloc -fno-builtin-valloc -fno-builtin-free -fno-builtin-strdup -fno-builtin-strndup -analyzer-output=html -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /home/ben/Projects/vmm/scan-build/2022-01-12-194120-40624-1 -x c Dumper.c
1/*
2 * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the
3 * contents of Dumper.xs. Do not edit this file, edit Dumper.xs instead.
4 *
5 * ANY CHANGES MADE HERE WILL BE LOST!
6 *
7 */
8
9#line 1 "Dumper.xs"
10#define PERL_NO_GET_CONTEXT
11#include "EXTERN.h"
12#include "perl.h"
13#include "XSUB.h"
14#ifdef USE_PPPORT_H
15# define NEED_my_snprintf
16# define NEED_sv_2pv_flags
17# include "ppport.h"
18#endif
19
20#if PERL_VERSION32 < 8
21# define DD_USE_OLD_ID_FORMAT
22#endif
23
24#ifndef strlcpy
25# ifdef my_strlcpystrlcpy
26# define strlcpy(d,s,l)strlcpy(d,s,l) my_strlcpy(d,s,l)strlcpy(d,s,l)
27# else
28# define strlcpy(d,s,l)strlcpy(d,s,l) strcpy(d,s)
29# endif
30#endif
31
32/* These definitions are ASCII only. But the pure-perl .pm avoids
33 * calling this .xs file for releases where they aren't defined */
34
35#ifndef isASCII
36# define isASCII(c)((U64)((c) | 0) < 128) (((UV) (c)) < 128)
37#endif
38
39#ifndef ESC_NATIVE0x1B /* \e */
40# define ESC_NATIVE0x1B 27
41#endif
42
43#ifndef isPRINT
44# define isPRINT(c)( ( (sizeof(c) == sizeof(U8)) ? ( (((U64) (((((U8) (c)))) - (
((' ')) | 0))) <= (((U64) ((((0x7e) - (' '))) | 0))))) : (
sizeof(c) == sizeof(U32)) ? ( (((U64) (((((U32) (c)))) - (((' '
)) | 0))) <= (((U64) ((((0x7e) - (' '))) | 0))))) : ( ( ((
(U64) (((((U64) (c)))) - (((' ')) | 0))) <= (((U64) ((((0x7e
) - (' '))) | 0))))))))
(((UV) (c)) >= ' ' && ((UV) (c)) < 127)
45#endif
46
47#ifndef isALPHA
48# define isALPHA(c)( ( (sizeof((~('A' ^ 'a') & (c))) == sizeof(U8)) ? ( (((U64
) (((((U8) ((~('A' ^ 'a') & (c)))))) - ((('A')) | 0))) <=
(((U64) (((('Z') - ('A'))) | 0))))) : (sizeof((~('A' ^ 'a') &
(c))) == sizeof(U32)) ? ( (((U64) (((((U32) ((~('A' ^ 'a') &
(c)))))) - ((('A')) | 0))) <= (((U64) (((('Z') - ('A'))) |
0))))) : ( ( (((U64) (((((U64) ((~('A' ^ 'a') & (c))))))
- ((('A')) | 0))) <= (((U64) (((('Z') - ('A'))) | 0))))))
))
( (((UV) (c)) >= 'a' && ((UV) (c)) <= 'z') \
49 || (((UV) (c)) <= 'Z' && ((UV) (c)) >= 'A'))
50#endif
51
52#ifndef isIDFIRST
53# define isIDFIRST(c)(( (sizeof(c) == 1) || !(((U64)((c) | 0)) & ~0xFF)) &&
((PL_charclass[(U8) (c)] & ((1U << (16)) | (1U <<
(14)))) == ((1U << (16)) | (1U << (14)))))
(isALPHA(c)( ( (sizeof((~('A' ^ 'a') & (c))) == sizeof(U8)) ? ( (((U64
) (((((U8) ((~('A' ^ 'a') & (c)))))) - ((('A')) | 0))) <=
(((U64) (((('Z') - ('A'))) | 0))))) : (sizeof((~('A' ^ 'a') &
(c))) == sizeof(U32)) ? ( (((U64) (((((U32) ((~('A' ^ 'a') &
(c)))))) - ((('A')) | 0))) <= (((U64) (((('Z') - ('A'))) |
0))))) : ( ( (((U64) (((((U64) ((~('A' ^ 'a') & (c))))))
- ((('A')) | 0))) <= (((U64) (((('Z') - ('A'))) | 0))))))
))
|| (c) == '_')
54#endif
55
56#ifndef isWORDCHAR
57# define isWORDCHAR(c)(( (sizeof(c) == 1) || !(((U64)((c) | 0)) & ~0xFF)) &&
((PL_charclass[(U8) (c)] & ((1U << (0)) | (1U <<
(14)))) == ((1U << (0)) | (1U << (14)))))
(isIDFIRST(c)(( (sizeof(c) == 1) || !(((U64)((c) | 0)) & ~0xFF)) &&
((PL_charclass[(U8) (c)] & ((1U << (16)) | (1U <<
(14)))) == ((1U << (16)) | (1U << (14)))))
\
58 || (((UV) (c)) >= '0' && ((UV) (c)) <= '9'))
59#endif
60
61/* SvPVCLEAR only from perl 5.25.6 */
62#ifndef SvPVCLEAR
63# define SvPVCLEAR(sv)Perl_sv_setpv_bufsize( sv,0,0) sv_setpvs((sv), "")Perl_sv_setpvn( (sv), ("" "" ""), (sizeof("")-1))
64#endif
65
66#ifndef memBEGINs
67# define memBEGINs(s1, l, s2)( (l) >= sizeof(s2) - 1 && (memcmp(((const void *)
(s1)), ((const void *) ("" s2 "")), sizeof(s2)-1) == 0))
\
68 ( (l) >= sizeof(s2) - 1 \
69 && memEQ(s1, "" s2 "", sizeof(s2)-1)(memcmp(((const void *) (s1)), ((const void *) ("" s2 "")), sizeof
(s2)-1) == 0)
)
70#endif
71
72/* This struct contains almost all the user's desired configuration, and it
73 * is treated as mostly constant (except for maxrecursed) by the recursive
74 * function. This arrangement has the advantage of needing less memory
75 * than passing all of them on the stack all the time (as was the case in
76 * an earlier implementation). */
77typedef struct {
78 SV *pad;
79 SV *xpad;
80 SV *sep;
81 SV *pair;
82 SV *sortkeys;
83 SV *freezer;
84 SV *toaster;
85 SV *bless;
86 IV maxrecurse;
87 bool_Bool maxrecursed; /* at some point we exceeded the maximum recursion level */
88 I32 indent;
89 I32 purity;
90 I32 deepcopy;
91 I32 quotekeys;
92 I32 maxdepth;
93 I32 useqq;
94 int use_sparse_seen_hash;
95 int trailingcomma;
96 int deparse;
97} Style;
98
99static STRLEN num_q (const char *s, STRLEN slen);
100static STRLEN esc_q (char *dest, const char *src, STRLEN slen);
101static STRLEN esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq);
102static bool_Bool globname_needs_quote(const char *s, STRLEN len);
103#ifndef GvNAMEUTF8
104static bool_Bool globname_supra_ascii(const char *s, STRLEN len);
105#endif
106static bool_Bool key_needs_quote(const char *s, STRLEN len);
107static bool_Bool safe_decimal_number(const char *p, STRLEN len);
108static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
109static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
110 HV *seenhv, AV *postav, const I32 level, SV *apad,
111 Style *style);
112
113#ifndef HvNAME_get
114#define HvNAME_get HvNAME
115#endif
116
117/* Perls 7 through portions of 15 used utf8_to_uvchr() which didn't have a
118 * length parameter. This wrongly allowed reading beyond the end of buffer
119 * given malformed input */
120
121#if PERL_VERSION32 <= 6 /* Perl 5.6 and earlier */
122
123UV
124Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen)
125{
126 const UV uv = utf8_to_uv(s, send - s, retlen,
127 ckWARN(WARN_UTF8)Perl_ckwarn( (44 )) ? 0 : UTF8_ALLOW_ANY( 0x0002 |0x0004 |0x0008 |0x0010 |0x0080));
128 return UNI_TO_NATIVE(uv)((UV) ((uv) | 0));
129}
130
131# if !defined(PERL_IMPLICIT_CONTEXT)
132# define utf8_to_uvchr_buf Perl_utf8_to_uvchr_buf
133# else
134# define utf8_to_uvchr_buf(a,b,c)Perl_utf8_to_uvchr_buf_helper( (const U8 *) (a),(const U8 *) b
,c)
Perl_utf8_to_uvchr_buf(aTHX_ a,b,c)
135# endif
136
137#endif /* PERL_VERSION <= 6 */
138
139/* Perl 5.7 through part of 5.15 */
140#if PERL_VERSION32 > 6 && PERL_VERSION32 <= 15 && ! defined(utf8_to_uvchr_buf)
141
142UV
143Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen)
144{
145 /* We have to discard <send> for these versions; hence can read off the
146 * end of the buffer if there is a malformation that indicates the
147 * character is longer than the space available */
148
149 return utf8_to_uvchr(s, retlen)Perl_utf8_to_uvchr( s,retlen);
150}
151
152# if !defined(PERL_IMPLICIT_CONTEXT)
153# define utf8_to_uvchr_buf Perl_utf8_to_uvchr_buf
154# else
155# define utf8_to_uvchr_buf(a,b,c)Perl_utf8_to_uvchr_buf_helper( (const U8 *) (a),(const U8 *) b
,c)
Perl_utf8_to_uvchr_buf(aTHX_ a,b,c)
156# endif
157
158#endif /* PERL_VERSION > 6 && <= 15 */
159
160/* Changes in 5.7 series mean that now IOK is only set if scalar is
161 precisely integer but in 5.6 and earlier we need to do a more
162 complex test */
163#if PERL_VERSION32 <= 6
164#define DD_is_integer(sv)((sv)->sv_flags & 0x00000100) (SvIOK(sv)((sv)->sv_flags & 0x00000100) && (SvIsUV(val)((val)->sv_flags & 0x80000000) ? SvUV(sv)((((sv)->sv_flags & (0x00000100|0x80000000|0x00200000)
) == (0x00000100|0x80000000)) ? ((XPVUV*) (sv)->sv_any)->
xuv_u.xivu_uv : Perl_sv_2uv_flags( sv,2))
== SvNV(sv)((((sv)->sv_flags & (0x00000200|0x00200000)) == 0x00000200
) ? ((XPVNV*) (sv)->sv_any)->xnv_u.xnv_nv : Perl_sv_2nv_flags
( sv,2))
: SvIV(sv)((((sv)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (sv)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( sv,2))
== SvNV(sv)((((sv)->sv_flags & (0x00000200|0x00200000)) == 0x00000200
) ? ((XPVNV*) (sv)->sv_any)->xnv_u.xnv_nv : Perl_sv_2nv_flags
( sv,2))
))
165#else
166#define DD_is_integer(sv)((sv)->sv_flags & 0x00000100) SvIOK(sv)((sv)->sv_flags & 0x00000100)
167#endif
168
169/* does a glob name need to be protected? */
170static bool_Bool
171globname_needs_quote(const char *ss, STRLEN len)
172{
173 const U8 *s = (const U8 *) ss;
174 const U8 *send = s+len;
175TOP:
176 if (s[0] == ':') {
177 if (++s<send) {
178 if (*s++ != ':')
179 return TRUE(1);
180 }
181 else
182 return TRUE(1);
183 }
184 if (isIDFIRST(*s)(( (sizeof(*s) == 1) || !(((U64)((*s) | 0)) & ~0xFF)) &&
((PL_charclass[(U8) (*s)] & ((1U << (16)) | (1U <<
(14)))) == ((1U << (16)) | (1U << (14)))))
) {
185 while (++s<send)
186 if (!isWORDCHAR(*s)(( (sizeof(*s) == 1) || !(((U64)((*s) | 0)) & ~0xFF)) &&
((PL_charclass[(U8) (*s)] & ((1U << (0)) | (1U <<
(14)))) == ((1U << (0)) | (1U << (14)))))
) {
187 if (*s == ':')
188 goto TOP;
189 else
190 return TRUE(1);
191 }
192 }
193 else
194 return TRUE(1);
195
196 return FALSE(0);
197}
198
199#ifndef GvNAMEUTF8
200/* does a glob name contain supra-ASCII characters? */
201static bool_Bool
202globname_supra_ascii(const char *ss, STRLEN len)
203{
204 const U8 *s = (const U8 *) ss;
205 const U8 *send = s+len;
206 while (s < send) {
207 if (!isASCII(*s)((U64)((*s) | 0) < 128))
208 return TRUE(1);
209 s++;
210 }
211 return FALSE(0);
212}
213#endif
214
215/* does a hash key need to be quoted (to the left of => ).
216 Previously this used (globname_)needs_quote() which accepted strings
217 like '::foo', but these aren't safe as unquoted keys under strict.
218*/
219static bool_Bool
220key_needs_quote(const char *s, STRLEN len) {
221 const char *send = s+len;
222
223 if (safe_decimal_number(s, len)) {
224 return FALSE(0);
225 }
226 else if (isIDFIRST(*s)(( (sizeof(*s) == 1) || !(((U64)((*s) | 0)) & ~0xFF)) &&
((PL_charclass[(U8) (*s)] & ((1U << (16)) | (1U <<
(14)))) == ((1U << (16)) | (1U << (14)))))
) {
227 while (++s<send)
228 if (!isWORDCHAR(*s)(( (sizeof(*s) == 1) || !(((U64)((*s) | 0)) & ~0xFF)) &&
((PL_charclass[(U8) (*s)] & ((1U << (0)) | (1U <<
(14)))) == ((1U << (0)) | (1U << (14)))))
)
229 return TRUE(1);
230 }
231 else
232 return TRUE(1);
233
234 return FALSE(0);
235}
236
237/* Check that the SV can be represented as a simple decimal integer.
238 *
239 * The perl code does this by matching against /^(?:0|-?[1-9]\d{0,8})\z/
240*/
241static bool_Bool
242safe_decimal_number(const char *p, STRLEN len) {
243 if (len == 1 && *p == '0')
244 return TRUE(1);
245
246 if (len && *p == '-') {
247 ++p;
248 --len;
249 }
250
251 if (len == 0 || *p < '1' || *p > '9')
252 return FALSE(0);
253
254 ++p;
255 --len;
256
257 if (len > 8)
258 return FALSE(0);
259
260 while (len > 0) {
261 /* the perl code checks /\d/ but we don't want unicode digits here */
262 if (*p < '0' || *p > '9')
263 return FALSE(0);
264 ++p;
265 --len;
266 }
267 return TRUE(1);
268}
269
270/* count the number of "'"s and "\"s in string */
271static STRLEN
272num_q(const char *s, STRLEN slen)
273{
274 STRLEN ret = 0;
275
276 while (slen > 0) {
277 if (*s == '\'' || *s == '\\')
278 ++ret;
279 ++s;
280 --slen;
281 }
282 return ret;
283}
284
285
286/* returns number of chars added to escape "'"s and "\"s in s */
287/* slen number of characters in s will be escaped */
288/* destination must be long enough for additional chars */
289static STRLEN
290esc_q(char *d, const char *s, STRLEN slen)
291{
292 STRLEN ret = 0;
293
294 while (slen > 0) {
295 switch (*s) {
296 case '\'':
297 case '\\':
298 *d = '\\';
299 ++d; ++ret;
300 /* FALLTHROUGH */
301 default:
302 *d = *s;
303 ++d; ++s; --slen;
304 break;
305 }
306 }
307 return ret;
308}
309
310/* this function is also misused for implementing $Useqq */
311static STRLEN
312esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
313{
314 char *r, *rstart;
315 const char *s = src;
316 const char * const send = src + slen;
317 STRLEN j, cur = SvCUR(sv)((XPV*) (sv)->sv_any)->xpv_cur;
318 /* Could count 128-255 and 256+ in two variables, if we want to
319 be like &qquote and make a distinction. */
320 STRLEN grow = 0; /* bytes needed to represent chars 128+ */
321 /* STRLEN topbit_grow = 0; bytes needed to represent chars 128-255 */
322 STRLEN backslashes = 0;
323 STRLEN single_quotes = 0;
324 STRLEN qq_escapables = 0; /* " $ @ will need a \ in "" strings. */
325 STRLEN normal = 0;
326 int increment;
327
328 for (s = src; s < send; s += increment) { /* Sizing pass */
329 UV k = *(U8*)s;
330
331 increment = 1; /* Will override if necessary for utf-8 */
332
333 if (isPRINT(k)( ( (sizeof(k) == sizeof(U8)) ? ( (((U64) (((((U8) (k)))) - (
((' ')) | 0))) <= (((U64) ((((0x7e) - (' '))) | 0))))) : (
sizeof(k) == sizeof(U32)) ? ( (((U64) (((((U32) (k)))) - (((' '
)) | 0))) <= (((U64) ((((0x7e) - (' '))) | 0))))) : ( ( ((
(U64) (((((U64) (k)))) - (((' ')) | 0))) <= (((U64) ((((0x7e
) - (' '))) | 0))))))))
) {
334 if (k == '\\') {
335 backslashes++;
336 } else if (k == '\'') {
337 single_quotes++;
338 } else if (k == '"' || k == '$' || k == '@') {
339 qq_escapables++;
340 } else {
341 normal++;
342 }
343 }
344 else if (! isASCII(k)((U64)((k) | 0) < 128) && k > ' ') {
345 /* High ordinal non-printable code point. (The test that k is
346 * above SPACE should be optimized out by the compiler on
347 * non-EBCDIC platforms; otherwise we could put an #ifdef around
348 * it, but it's better to have just a single code path when
349 * possible. All but one of the non-ASCII EBCDIC controls are low
350 * ordinal; that one is the only one above SPACE.)
351 *
352 * If UTF-8, output as hex, regardless of useqq. This means there
353 * is an overhead of 4 chars '\x{}'. Then count the number of hex
354 * digits. */
355 if (do_utf8) {
356 k = utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL)Perl_utf8_to_uvchr_buf_helper( (const U8 *) ((U8*)s),(const U8
*) (U8*) send,((void*)0))
;
357
358 /* treat invalid utf8 byte by byte. This loop iteration gets the
359 * first byte */
360 increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s)PL_utf8skip[*(const U8*)(s)];
361
362 grow += 4 + (k <= 0xFF ? 2 : k <= 0xFFF ? 3 : k <= 0xFFFF ? 4 :
363#if UVSIZE8 == 4
364 8 /* We may allocate a bit more than the minimum here. */
365#else
366 k <= 0xFFFFFFFF ? 8 : UVSIZE8 * 4
367#endif
368 );
369 }
370 else if (useqq) { /* Not utf8, must be <= 0xFF, hence 2 hex
371 * digits. */
372 grow += 4 + 2;
373 }
374 else { /* Non-qq generates 3 octal digits plus backslash */
375 grow += 4;
376 }
377 } /* End of high-ordinal non-printable */
378 else if (! useqq) { /* Low ordinal, non-printable, non-qq just
379 * outputs the raw char */
380 normal++;
381 }
382 else { /* Is qq, low ordinal, non-printable. Output escape
383 * sequences */
384 if ( k == '\a' || k == '\b' || k == '\t' || k == '\n' || k == '\r'
385 || k == '\f' || k == ESC_NATIVE0x1B)
386 {
387 grow += 2; /* 1 char plus backslash */
388 }
389 else /* The other low ordinals are output as an octal escape
390 * sequence */
391 if (s + 1 >= send || ( *(U8*)(s+1) >= '0'
392 && *(U8*)(s+1) <= '9'))
393 {
394 /* When the following character is a digit, use 3 octal digits
395 * plus backslash, as using fewer digits would concatenate the
396 * following char into this one */
397 grow += 4;
398 }
399 else if (k <= 7) {
400 grow += 2; /* 1 octal digit, plus backslash */
401 }
402 else if (k <= 077) {
403 grow += 3; /* 2 octal digits plus backslash */
404 }
405 else {
406 grow += 4; /* 3 octal digits plus backslash */
407 }
408 }
409 } /* End of size-calculating loop */
410
411 if (grow || useqq) {
412 /* We have something needing hex. 3 is ""\0 */
413 sv_grow(sv, cur + 3 + grow + 2*backslashes + single_quotesPerl_sv_grow( sv,cur + 3 + grow + 2*backslashes + single_quotes
+ 2*qq_escapables + normal)
414 + 2*qq_escapables + normal)Perl_sv_grow( sv,cur + 3 + grow + 2*backslashes + single_quotes
+ 2*qq_escapables + normal)
;
415 rstart = r = SvPVX(sv)((sv)->sv_u.svu_pv) + cur;
416
417 *r++ = '"';
418
419 for (s = src; s < send; s += increment) {
420 U8 c0 = *(U8 *)s;
421 UV k;
422
423 if (do_utf8
424 && ! isASCII(c0)((U64)((c0) | 0) < 128)
425 /* Exclude non-ASCII low ordinal controls. This should be
426 * optimized out by the compiler on ASCII platforms; if not
427 * could wrap it in a #ifdef EBCDIC, but better to avoid
428 * #if's if possible */
429 && c0 > ' '
430 ) {
431
432 /* When in UTF-8, we output all non-ascii chars as \x{}
433 * reqardless of useqq, except for the low ordinal controls on
434 * EBCDIC platforms */
435 k = utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL)Perl_utf8_to_uvchr_buf_helper( (const U8 *) ((U8*)s),(const U8
*) (U8*) send,((void*)0))
;
436
437 /* treat invalid utf8 byte by byte. This loop iteration gets the
438 * first byte */
439 increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s)PL_utf8skip[*(const U8*)(s)];
440
441#if PERL_VERSION32 < 10
442 sprintf(r, "\\x{%" UVxf"lx" "}", k);
443 r += strlen(r);
444 /* my_sprintf is not supported by ppport.h */
445#else
446 r = r + my_sprintfsprintf(r, "\\x{%" UVxf"lx" "}", k);
447#endif
448 continue;
449 }
450
451 /* Here 1) isn't UTF-8; or
452 * 2) the current character is ASCII; or
453 * 3) it is an EBCDIC platform and is a low ordinal
454 * non-ASCII control.
455 * In each case the character occupies just one byte */
456 k = *(U8*)s;
457 increment = 1;
458
459 if (isPRINT(k)( ( (sizeof(k) == sizeof(U8)) ? ( (((U64) (((((U8) (k)))) - (
((' ')) | 0))) <= (((U64) ((((0x7e) - (' '))) | 0))))) : (
sizeof(k) == sizeof(U32)) ? ( (((U64) (((((U32) (k)))) - (((' '
)) | 0))) <= (((U64) ((((0x7e) - (' '))) | 0))))) : ( ( ((
(U64) (((((U64) (k)))) - (((' ')) | 0))) <= (((U64) ((((0x7e
) - (' '))) | 0))))))))
) {
460 /* These need a backslash escape */
461 if (k == '"' || k == '\\' || k == '$' || k == '@') {
462 *r++ = '\\';
463 }
464
465 *r++ = (char)k;
466 }
467 else if (! useqq) { /* non-qq, non-printable, low-ordinal is
468 * output raw */
469 *r++ = (char)k;
470 }
471 else { /* Is qq means use escape sequences */
472 bool_Bool next_is_digit;
473
474 *r++ = '\\';
475 switch (k) {
476 case '\a': *r++ = 'a'; break;
477 case '\b': *r++ = 'b'; break;
478 case '\t': *r++ = 't'; break;
479 case '\n': *r++ = 'n'; break;
480 case '\f': *r++ = 'f'; break;
481 case '\r': *r++ = 'r'; break;
482 case ESC_NATIVE0x1B: *r++ = 'e'; break;
483 default:
484
485 /* only ASCII digits matter here, which are invariant,
486 * since we only encode characters \377 and under, or
487 * \x177 and under for a unicode string
488 */
489 next_is_digit = (s + 1 >= send )
490 ? FALSE(0)
491 : (*(U8*)(s+1) >= '0' && *(U8*)(s+1) <= '9');
492
493 /* faster than
494 * r = r + my_sprintf(r, "%o", k);
495 */
496 if (k <= 7 && !next_is_digit) {
497 *r++ = (char)k + '0';
498 } else if (k <= 63 && !next_is_digit) {
499 *r++ = (char)(k>>3) + '0';
500 *r++ = (char)(k&7) + '0';
501 } else {
502 *r++ = (char)(k>>6) + '0';
503 *r++ = (char)((k&63)>>3) + '0';
504 *r++ = (char)(k&7) + '0';
505 }
506 }
507 }
508 }
509 *r++ = '"';
510 } else {
511 /* Single quotes. */
512 sv_grow(sv, cur + 3 + 2*backslashes + 2*single_quotesPerl_sv_grow( sv,cur + 3 + 2*backslashes + 2*single_quotes + qq_escapables
+ normal)
513 + qq_escapables + normal)Perl_sv_grow( sv,cur + 3 + 2*backslashes + 2*single_quotes + qq_escapables
+ normal)
;
514 rstart = r = SvPVX(sv)((sv)->sv_u.svu_pv) + cur;
515 *r++ = '\'';
516 for (s = src; s < send; s ++) {
517 const char k = *s;
518 if (k == '\'' || k == '\\')
519 *r++ = '\\';
520 *r++ = k;
521 }
522 *r++ = '\'';
523 }
524 *r = '\0';
525 j = r - rstart;
526 SvCUR_set(sv, cur + j)do { ((void)0); ((void)0); ((void)0); (((XPV*) (sv)->sv_any
)->xpv_cur = (cur + j)); } while (0)
;
527
528 return j;
529}
530
531/* append a repeated string to an SV */
532static SV *
533sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
534{
535 if (!sv)
536 sv = newSVpvs("")Perl_newSVpvn( ("" "" ""), (sizeof("")-1));
537#ifdef DEBUGGING
538 else
539 assert(SvTYPE(sv) >= SVt_PV)((void)0);
540#endif
541
542 if (n > 0) {
543 SvGROW(sv, len*n + SvCUR(sv) + 1)(((sv)->sv_flags & 0x10000000) || ((XPV*) (sv)->sv_any
)->xpv_len_u.xpvlenu_len < (len*n + ((XPV*) (sv)->sv_any
)->xpv_cur + 1) ? Perl_sv_grow( sv,len*n + ((XPV*) (sv)->
sv_any)->xpv_cur + 1) : ((sv)->sv_u.svu_pv))
;
544 if (len == 1) {
545 char * const start = SvPVX(sv)((sv)->sv_u.svu_pv) + SvCUR(sv)((XPV*) (sv)->sv_any)->xpv_cur;
546 SvCUR_set(sv, SvCUR(sv) + n)do { ((void)0); ((void)0); ((void)0); (((XPV*) (sv)->sv_any
)->xpv_cur = (((XPV*) (sv)->sv_any)->xpv_cur + n)); }
while (0)
;
547 start[n] = '\0';
548 while (n > 0)
549 start[--n] = str[0];
550 }
551 else
552 while (n > 0) {
553 sv_catpvn(sv, str, len)Perl_sv_catpvn_flags( sv,str,len,2);
554 --n;
555 }
556 }
557 return sv;
558}
559
560static SV *
561deparsed_output(pTHX_ SV *val)
562{
563 SV *text;
564 int n;
565 dSPSV **sp = PL_stack_sp;
566
567 /* This is passed to load_module(), which decrements its ref count and
568 * modifies it (so we also can't reuse it below) */
569 SV *pkg = newSVpvs("B::Deparse")Perl_newSVpvn( ("" "B::Deparse" ""), (sizeof("B::Deparse")-1)
)
;
570
571 /* Commit ebdc88085efa6fca8a1b0afaa388f0491bdccd5a (first released as part
572 * of 5.19.7) changed core S_process_special_blocks() to use a new stack
573 * for anything using a BEGIN block, on the grounds that doing so "avoids
574 * the stack moving underneath anything that directly or indirectly calls
575 * Perl_load_module()". If we're in an older Perl, we can't rely on that
576 * stack, and must create a fresh sacrificial stack of our own. */
577#if PERL_VERSION32 < 20
578 PUSHSTACKi(PERLSI_REQUIRE)do { PERL_SI *next = PL_curstackinfo->si_next; if (!next) {
next = Perl_new_stackinfo( 32,2048/sizeof(PERL_CONTEXT) - 1)
; next->si_prev = PL_curstackinfo; PL_curstackinfo->si_next
= next; } next->si_type = 9; next->si_cxix = -1; next->
si_cxsubix = -1; (void)0; ((XPVAV*) (next->si_stack)->sv_any
)->xav_fill = 0; do { ((XPVAV*) (PL_curstack)->sv_any)->
xav_fill = sp - PL_stack_base; PL_stack_base = ((next->si_stack
)->sv_u.svu_array); PL_stack_max = PL_stack_base + ((XPVAV
*) (next->si_stack)->sv_any)->xav_max; sp = PL_stack_sp
= PL_stack_base + ((XPVAV*) (next->si_stack)->sv_any)->
xav_fill; PL_curstack = next->si_stack; } while (0); PL_curstackinfo
= next; (void)0; } while (0)
;
579#endif
580
581 load_modulePerl_load_module(PERL_LOADMOD_NOIMPORT0x2, pkg, 0);
582
583#if PERL_VERSION32 < 20
584 POPSTACKdo { SV **sp = PL_stack_sp; PERL_SI * const prev = PL_curstackinfo
->si_prev; if (!prev) { Perl_croak_popstack(); } do { ((XPVAV
*) (PL_curstack)->sv_any)->xav_fill = sp - PL_stack_base
; PL_stack_base = ((prev->si_stack)->sv_u.svu_array); PL_stack_max
= PL_stack_base + ((XPVAV*) (prev->si_stack)->sv_any)->
xav_max; sp = PL_stack_sp = PL_stack_base + ((XPVAV*) (prev->
si_stack)->sv_any)->xav_fill; PL_curstack = prev->si_stack
; } while (0); PL_curstackinfo = prev; } while (0)
;
585 SPAGAINsp = PL_stack_sp;
586#endif
587
588 SAVETMPSPerl_savetmps();
589
590 PUSHMARK(SP)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0)
;
591 mXPUSHs(newSVpvs("B::Deparse"))do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (Perl_sv_2mortal( Perl_newSVpvn( ("" "B::Deparse" ""),
(sizeof("B::Deparse")-1)))); } while (0)
;
592 PUTBACKPL_stack_sp = sp;
593
594 n = call_method("new", G_SCALAR)Perl_call_method( "new",2);
595 SPAGAINsp = PL_stack_sp;
596
597 if (n != 1) {
598 croakPerl_croak("B::Deparse->new returned %d items, but expected exactly 1", n);
599 }
600
601 PUSHMARK(SP - n)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp - n) - PL_stack_base); ; } while (0)
;
602 XPUSHs(val)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (val); } while (0)
;
603 PUTBACKPL_stack_sp = sp;
604
605 n = call_method("coderef2text", G_SCALAR)Perl_call_method( "coderef2text",2);
606 SPAGAINsp = PL_stack_sp;
607
608 if (n != 1) {
609 croakPerl_croak("$b_deparse->coderef2text returned %d items, but expected exactly 1", n);
610 }
611
612 text = POPs(*sp--);
613 SvREFCNT_inc(text)Perl_SvREFCNT_inc(((SV *)({ void *_p = (text); _p; }))); /* the caller will mortalise this */
614
615 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
616
617 PUTBACKPL_stack_sp = sp;
618
619 return text;
620}
621
622/*
623 * This ought to be split into smaller functions. (it is one long function since
624 * it exactly parallels the perl version, which was one long thing for
625 * efficiency raisins.) Ugggh!
626 */
627static I32
628DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
629 AV *postav, const I32 level, SV *apad, Style *style)
630{
631 char tmpbuf[128];
632 Size_tsize_t i;
633 char *c, *r, *realpack;
634#ifdef DD_USE_OLD_ID_FORMAT
635 char id[128];
636#else
637 UV id_buffer;
638 char *const id = (char *)&id_buffer;
639#endif
640 SV **svp;
641 SV *sv, *ipad, *ival;
642 SV *blesspad = Nullsv((SV*)((void*)0));
643 AV *seenentry = NULL((void*)0);
644 char *iname;
645 STRLEN inamelen, idlen = 0;
646 U32 realtype;
647 bool_Bool no_bless = 0; /* when a qr// is blessed into Regexp we dont want to bless it.
648 in later perls we should actually check the classname of the
649 engine. this gets tricky as it involves lexical issues that arent so
650 easy to resolve */
651 bool_Bool is_regex = 0; /* we are dumping a regex, we need to know this before we bless */
652
653 if (!val)
654 return 0;
655
656 if (style->maxrecursed)
657 return 0;
658
659 /* If the output buffer has less than some arbitrary amount of space
660 remaining, then enlarge it. For the test case (25M of output),
661 *1.1 was slower, *2.0 was the same, so the first guess of 1.5 is
662 deemed to be good enough. */
663 if (SvTYPE(retval)((svtype)((retval)->sv_flags & 0xff)) >= SVt_PV && (SvLEN(retval)((XPV*) (retval)->sv_any)->xpv_len_u.xpvlenu_len - SvCUR(retval)((XPV*) (retval)->sv_any)->xpv_cur) < 42) {
664 sv_grow(retval, SvCUR(retval) * 3 / 2)Perl_sv_grow( retval,((XPV*) (retval)->sv_any)->xpv_cur
* 3 / 2)
;
665 }
666
667 realtype = SvTYPE(val)((svtype)((val)->sv_flags & 0xff));
668
669 if (SvGMAGICAL(val)((val)->sv_flags & 0x00200000))
670 mg_get(val)Perl_mg_get( val);
671 if (SvROK(val)((val)->sv_flags & 0x00000800)) {
672
673 /* If a freeze method is provided and the object has it, call
674 it. Warn on errors. */
675 if (SvOBJECT(SvRV(val))((((val)->sv_u.svu_rv))->sv_flags & 0x00100000) && style->freezer &&
676 SvPOK(style->freezer)((style->freezer)->sv_flags & 0x00000400) && SvCUR(style->freezer)((XPV*) (style->freezer)->sv_any)->xpv_cur &&
677 gv_fetchmeth(SvSTASH(SvRV(val)), SvPVX_const(style->freezer),Perl_gv_fetchmeth_pvn( ((XPVMG*) (((val)->sv_u.svu_rv))->
sv_any)->xmg_stash,((const char*)(0 + (style->freezer)->
sv_u.svu_pv)),((XPV*) (style->freezer)->sv_any)->xpv_cur
,-1,0)
678 SvCUR(style->freezer), -1)Perl_gv_fetchmeth_pvn( ((XPVMG*) (((val)->sv_u.svu_rv))->
sv_any)->xmg_stash,((const char*)(0 + (style->freezer)->
sv_u.svu_pv)),((XPV*) (style->freezer)->sv_any)->xpv_cur
,-1,0)
!= NULL((void*)0))
679 {
680 dSPSV **sp = PL_stack_sp; ENTERPerl_push_scope(); SAVETMPSPerl_savetmps(); PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0)
;
681 XPUSHs(val)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (val); } while (0)
; PUTBACKPL_stack_sp = sp;
682 i = perl_call_method(SvPVX_const(style->freezer), G_EVAL|G_VOID|G_DISCARD)Perl_call_method( ((const char*)(0 + (style->freezer)->
sv_u.svu_pv)),0x8|1|0x4)
;
Value stored to 'i' is never read
683 SPAGAINsp = PL_stack_sp;
684 if (SvTRUE(ERRSV)Perl_SvTRUE( (*((0+(PL_errgv)->sv_u.svu_gp)->gp_sv ? &
((0+(PL_errgv)->sv_u.svu_gp)->gp_sv) : &((0+(Perl_gv_add_by_type
( (PL_errgv),SVt_NULL))->sv_u.svu_gp)->gp_sv))))
)
685 warnPerl_warn("WARNING(Freezer method call failed): %" SVf"-p", ERRSV(*((0+(PL_errgv)->sv_u.svu_gp)->gp_sv ? &((0+(PL_errgv
)->sv_u.svu_gp)->gp_sv) : &((0+(Perl_gv_add_by_type
( (PL_errgv),SVt_NULL))->sv_u.svu_gp)->gp_sv)))
);
686 PUTBACKPL_stack_sp = sp; FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps(); LEAVEPerl_pop_scope();
687 }
688
689 ival = SvRV(val)((val)->sv_u.svu_rv);
690 realtype = SvTYPE(ival)((svtype)((ival)->sv_flags & 0xff));
691#ifdef DD_USE_OLD_ID_FORMAT
692 idlen = my_snprintf(id, sizeof(id), "0x%" UVxf, PTR2UV(ival))({ int len = snprintf(id, sizeof(id), "0x%" "lx", (UV)(ival))
; do { if ((sizeof(id)) > 0 && (size_t)len > (sizeof
(id))) Perl_croak("panic: %s buffer overflow", "snprintf"); }
while (0); len; })
;
693#else
694 id_buffer = PTR2UV(ival)(UV)(ival);
695 idlen = sizeof(id_buffer);
696#endif
697 if (SvOBJECT(ival)((ival)->sv_flags & 0x00100000))
698 realpack = HvNAME_get(SvSTASH(ival))((((((XPVMG*) (ival)->sv_any)->xmg_stash)->sv_flags &
0x02000000) && ((struct xpvhv_aux*)&(((((XPVMG*)
(ival)->sv_any)->xmg_stash)->sv_u.svu_hash)[((XPVHV
*) (((XPVMG*) (ival)->sv_any)->xmg_stash)->sv_any)->
xhv_max+1]))->xhv_name_u.xhvnameu_name && ( ((struct
xpvhv_aux*)&(((((XPVMG*) (ival)->sv_any)->xmg_stash
)->sv_u.svu_hash)[((XPVHV*) (((XPVMG*) (ival)->sv_any)->
xmg_stash)->sv_any)->xhv_max+1]))->xhv_name_count ? *
((struct xpvhv_aux*)&(((((XPVMG*) (ival)->sv_any)->
xmg_stash)->sv_u.svu_hash)[((XPVHV*) (((XPVMG*) (ival)->
sv_any)->xmg_stash)->sv_any)->xhv_max+1]))->xhv_name_u
.xhvnameu_names : ((struct xpvhv_aux*)&(((((XPVMG*) (ival
)->sv_any)->xmg_stash)->sv_u.svu_hash)[((XPVHV*) (((
XPVMG*) (ival)->sv_any)->xmg_stash)->sv_any)->xhv_max
+1]))->xhv_name_u.xhvnameu_name )) ? (( ((struct xpvhv_aux
*)&(((((XPVMG*) (ival)->sv_any)->xmg_stash)->sv_u
.svu_hash)[((XPVHV*) (((XPVMG*) (ival)->sv_any)->xmg_stash
)->sv_any)->xhv_max+1]))->xhv_name_count ? *((struct
xpvhv_aux*)&(((((XPVMG*) (ival)->sv_any)->xmg_stash
)->sv_u.svu_hash)[((XPVHV*) (((XPVMG*) (ival)->sv_any)->
xmg_stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names
: ((struct xpvhv_aux*)&(((((XPVMG*) (ival)->sv_any)->
xmg_stash)->sv_u.svu_hash)[((XPVHV*) (((XPVMG*) (ival)->
sv_any)->xmg_stash)->sv_any)->xhv_max+1]))->xhv_name_u
.xhvnameu_name ))->hek_key : ((void*)0))
;
699 else
700 realpack = NULL((void*)0);
701
702 /* if it has a name, we need to either look it up, or keep a tab
703 * on it so we know when we hit it later
704 */
705 if (namelen) {
706 if ((svp = hv_fetch(seenhv, id, idlen, FALSE)((SV**) Perl_hv_common_key_len( (seenhv),(id),(idlen),((0)) ?
(0x20 | 0x10) : 0x20,((void*)0),0))
)
707 && (sv = *svp) && SvROK(sv)((sv)->sv_flags & 0x00000800) && (seenentry = (AV*)SvRV(sv)((sv)->sv_u.svu_rv)))
708 {
709 SV *othername;
710 if ((svp = av_fetch(seenentry, 0, FALSE)Perl_av_fetch( seenentry,0,(0)))
711 && (othername = *svp))
712 {
713 if (style->purity && level > 0) {
714 SV *postentry;
715
716 if (realtype == SVt_PVHV)
717 sv_catpvs(retval, "{}")Perl_sv_catpvn_flags( retval, ("" "{}" ""), (sizeof("{}")-1),
2)
;
718 else if (realtype == SVt_PVAV)
719 sv_catpvs(retval, "[]")Perl_sv_catpvn_flags( retval, ("" "[]" ""), (sizeof("[]")-1),
2)
;
720 else
721 sv_catpvs(retval, "do{my $o}")Perl_sv_catpvn_flags( retval, ("" "do{my $o}" ""), (sizeof("do{my $o}"
)-1), 2)
;
722 postentry = newSVpvn(name, namelen)Perl_newSVpvn( name,namelen);
723 sv_catpvs(postentry, " = ")Perl_sv_catpvn_flags( postentry, ("" " = " ""), (sizeof(" = "
)-1), 2)
;
724 sv_catsv(postentry, othername)Perl_sv_catsv_flags( postentry,othername,2);
725 av_push(postav, postentry)Perl_av_push( postav,postentry);
726 }
727 else {
728 if (name[0] == '@' || name[0] == '%') {
729 if ((SvPVX_const(othername)((const char*)(0 + (othername)->sv_u.svu_pv)))[0] == '\\' &&
730 (SvPVX_const(othername)((const char*)(0 + (othername)->sv_u.svu_pv)))[1] == name[0]) {
731 sv_catpvn(retval, SvPVX_const(othername)+1,Perl_sv_catpvn_flags( retval,((const char*)(0 + (othername)->
sv_u.svu_pv))+1,((XPV*) (othername)->sv_any)->xpv_cur-1
,2)
732 SvCUR(othername)-1)Perl_sv_catpvn_flags( retval,((const char*)(0 + (othername)->
sv_u.svu_pv))+1,((XPV*) (othername)->sv_any)->xpv_cur-1
,2)
;
733 }
734 else {
735 sv_catpvn(retval, name, 1)Perl_sv_catpvn_flags( retval,name,1,2);
736 sv_catpvs(retval, "{")Perl_sv_catpvn_flags( retval, ("" "{" ""), (sizeof("{")-1), 2
)
;
737 sv_catsv(retval, othername)Perl_sv_catsv_flags( retval,othername,2);
738 sv_catpvs(retval, "}")Perl_sv_catpvn_flags( retval, ("" "}" ""), (sizeof("}")-1), 2
)
;
739 }
740 }
741 else
742 sv_catsv(retval, othername)Perl_sv_catsv_flags( retval,othername,2);
743 }
744 return 1;
745 }
746 else {
747#ifdef DD_USE_OLD_ID_FORMAT
748 warnPerl_warn("ref name not found for %s", id);
749#else
750 warnPerl_warn("ref name not found for 0x%" UVxf"lx", PTR2UV(ival)(UV)(ival));
751#endif
752 return 0;
753 }
754 }
755 else { /* store our name and continue */
756 SV *namesv;
757 if (name[0] == '@' || name[0] == '%') {
758 namesv = newSVpvs("\\")Perl_newSVpvn( ("" "\\" ""), (sizeof("\\")-1));
759 sv_catpvn(namesv, name, namelen)Perl_sv_catpvn_flags( namesv,name,namelen,2);
760 }
761 else if (realtype == SVt_PVCV && name[0] == '*') {
762 namesv = newSVpvs("\\")Perl_newSVpvn( ("" "\\" ""), (sizeof("\\")-1));
763 sv_catpvn(namesv, name, namelen)Perl_sv_catpvn_flags( namesv,name,namelen,2);
764 (SvPVX(namesv)((namesv)->sv_u.svu_pv))[1] = '&';
765 }
766 else
767 namesv = newSVpvn(name, namelen)Perl_newSVpvn( name,namelen);
768 seenentry = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; }));
769 av_push(seenentry, namesv)Perl_av_push( seenentry,namesv);
770 (void)SvREFCNT_inc(val)Perl_SvREFCNT_inc(((SV *)({ void *_p = (val); _p; })));
771 av_push(seenentry, val)Perl_av_push( seenentry,val);
772 (void)hv_store(seenhv, id, idlen,((SV**) Perl_hv_common_key_len( (seenhv),(id),(idlen),(0x04|0x20
),(Perl_newRV( (SV*)seenentry)),(0)))
773 newRV_inc((SV*)seenentry), 0)((SV**) Perl_hv_common_key_len( (seenhv),(id),(idlen),(0x04|0x20
),(Perl_newRV( (SV*)seenentry)),(0)))
;
774 SvREFCNT_dec(seenentry)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (seenentry); _p; })));
775 }
776 }
777 /* regexps dont have to be blessed into package "Regexp"
778 * they can be blessed into any package.
779 */
780#if PERL_VERSION32 < 8
781 if (realpack && *realpack == 'R' && strEQ(realpack, "Regexp")(strcmp(realpack,"Regexp") == 0))
782#elif PERL_VERSION32 < 11
783 if (realpack && realtype == SVt_PVMG && mg_findPerl_mg_find(ival, PERL_MAGIC_qr'r'))
784#else
785 if (realpack && realtype == SVt_REGEXP)
786#endif
787 {
788 is_regex = 1;
789 if (strEQ(realpack, "Regexp")(strcmp(realpack,"Regexp") == 0))
790 no_bless = 1;
791 else
792 no_bless = 0;
793 }
794
795 /* If purity is not set and maxdepth is set, then check depth:
796 * if we have reached maximum depth, return the string
797 * representation of the thing we are currently examining
798 * at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
799 */
800 if (!style->purity && style->maxdepth > 0 && level >= style->maxdepth) {
801 STRLEN vallen;
802 const char * const valstr = SvPV(val,vallen)((((val)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((vallen = ((XPV*) (val)->sv_any)->xpv_cur), ((val)
->sv_u.svu_pv)) : Perl_sv_2pv_flags( val,&vallen,2))
;
803 sv_catpvs(retval, "'")Perl_sv_catpvn_flags( retval, ("" "'" ""), (sizeof("'")-1), 2
)
;
804 sv_catpvn(retval, valstr, vallen)Perl_sv_catpvn_flags( retval,valstr,vallen,2);
805 sv_catpvs(retval, "'")Perl_sv_catpvn_flags( retval, ("" "'" ""), (sizeof("'")-1), 2
)
;
806 return 1;
807 }
808
809 if (style->maxrecurse > 0 && level >= style->maxrecurse) {
810 style->maxrecursed = TRUE(1);
811 }
812
813 if (realpack && !no_bless) { /* we have a blessed ref */
814 STRLEN blesslen;
815 const char * const blessstr = SvPV(style->bless, blesslen)((((style->bless)->sv_flags & (0x00000400|0x00200000
)) == 0x00000400) ? ((blesslen = ((XPV*) (style->bless)->
sv_any)->xpv_cur), ((style->bless)->sv_u.svu_pv)) : Perl_sv_2pv_flags
( style->bless,&blesslen,2))
;
816 sv_catpvn(retval, blessstr, blesslen)Perl_sv_catpvn_flags( retval,blessstr,blesslen,2);
817 sv_catpvs(retval, "( ")Perl_sv_catpvn_flags( retval, ("" "( " ""), (sizeof("( ")-1),
2)
;
818 if (style->indent >= 2) {
819 blesspad = apad;
820 apad = sv_2mortal(newSVsv(apad))Perl_sv_2mortal( Perl_newSVsv_flags( (apad),2|16));
821 sv_x(aTHX_ apad, " ", 1, blesslen+2);
822 }
823 }
824
825 ipad = sv_x(aTHX_ Nullsv((SV*)((void*)0)), SvPVX_const(style->xpad)((const char*)(0 + (style->xpad)->sv_u.svu_pv)), SvCUR(style->xpad)((XPV*) (style->xpad)->sv_any)->xpv_cur, level+1);
826 sv_2mortal(ipad)Perl_sv_2mortal( ipad);
827
828 if (is_regex)
829 {
830 STRLEN rlen;
831 SV *sv_pattern = NULL((void*)0);
832 SV *sv_flags = NULL((void*)0);
833 CV *re_pattern_cv;
834 const char *rval;
835 const char *rend;
836 const char *slash;
837
838 if ((re_pattern_cv = get_cv("re::regexp_pattern", 0)Perl_get_cv( "re::regexp_pattern",0))) {
839 dSPSV **sp = PL_stack_sp;
840 I32 count;
841 ENTERPerl_push_scope();
842 SAVETMPSPerl_savetmps();
843 PUSHMARK(SP)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0)
;
844 XPUSHs(val)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (val); } while (0)
;
845 PUTBACKPL_stack_sp = sp;
846 count = call_sv((SV*)re_pattern_cv, G_ARRAY)Perl_call_sv( (SV*)re_pattern_cv,3);
847 SPAGAINsp = PL_stack_sp;
848 if (count >= 2) {
849 sv_flags = POPs(*sp--);
850 sv_pattern = POPs(*sp--);
851 SvREFCNT_inc(sv_flags)Perl_SvREFCNT_inc(((SV *)({ void *_p = (sv_flags); _p; })));
852 SvREFCNT_inc(sv_pattern)Perl_SvREFCNT_inc(((SV *)({ void *_p = (sv_pattern); _p; })));
853 }
854 PUTBACKPL_stack_sp = sp;
855 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
856 LEAVEPerl_pop_scope();
857 if (sv_pattern) {
858 sv_2mortal(sv_pattern)Perl_sv_2mortal( sv_pattern);
859 sv_2mortal(sv_flags)Perl_sv_2mortal( sv_flags);
860 }
861 }
862 else {
863 sv_pattern = val;
864 }
865 assert(sv_pattern)((void)0);
866 rval = SvPV(sv_pattern, rlen)((((sv_pattern)->sv_flags & (0x00000400|0x00200000)) ==
0x00000400) ? ((rlen = ((XPV*) (sv_pattern)->sv_any)->
xpv_cur), ((sv_pattern)->sv_u.svu_pv)) : Perl_sv_2pv_flags
( sv_pattern,&rlen,2))
;
867 rend = rval+rlen;
868 slash = rval;
869 sv_catpvs(retval, "qr/")Perl_sv_catpvn_flags( retval, ("" "qr/" ""), (sizeof("qr/")-1
), 2)
;
870 for (;slash < rend; slash++) {
871 if (*slash == '\\') { ++slash; continue; }
872 if (*slash == '/') {
873 sv_catpvn(retval, rval, slash-rval)Perl_sv_catpvn_flags( retval,rval,slash-rval,2);
874 sv_catpvs(retval, "\\/")Perl_sv_catpvn_flags( retval, ("" "\\/" ""), (sizeof("\\/")-1
), 2)
;
875 rlen -= slash-rval+1;
876 rval = slash+1;
877 }
878 }
879 sv_catpvn(retval, rval, rlen)Perl_sv_catpvn_flags( retval,rval,rlen,2);
880 sv_catpvs(retval, "/")Perl_sv_catpvn_flags( retval, ("" "/" ""), (sizeof("/")-1), 2
)
;
881 if (sv_flags)
882 sv_catsv(retval, sv_flags)Perl_sv_catsv_flags( retval,sv_flags,2);
883 }
884 else if (
885#if PERL_VERSION32 < 9
886 realtype <= SVt_PVBMSVt_PVMG
887#else
888 realtype <= SVt_PVMG
889#endif
890 ) { /* scalar ref */
891 SV * const namesv = sv_2mortal(newSVpvs("${"))Perl_sv_2mortal( Perl_newSVpvn( ("" "${" ""), (sizeof("${")-1
)))
;
892 sv_catpvn(namesv, name, namelen)Perl_sv_catpvn_flags( namesv,name,namelen,2);
893 sv_catpvs(namesv, "}")Perl_sv_catpvn_flags( namesv, ("" "}" ""), (sizeof("}")-1), 2
)
;
894 if (realpack) { /* blessed */
895 sv_catpvs(retval, "do{\\(my $o = ")Perl_sv_catpvn_flags( retval, ("" "do{\\(my $o = " ""), (sizeof
("do{\\(my $o = ")-1), 2)
;
896 DD_dump(aTHX_ ival, SvPVX_const(namesv)((const char*)(0 + (namesv)->sv_u.svu_pv)), SvCUR(namesv)((XPV*) (namesv)->sv_any)->xpv_cur, retval, seenhv,
897 postav, level+1, apad, style);
898 sv_catpvs(retval, ")}")Perl_sv_catpvn_flags( retval, ("" ")}" ""), (sizeof(")}")-1),
2)
;
899 } /* plain */
900 else {
901 sv_catpvs(retval, "\\")Perl_sv_catpvn_flags( retval, ("" "\\" ""), (sizeof("\\")-1),
2)
;
902 DD_dump(aTHX_ ival, SvPVX_const(namesv)((const char*)(0 + (namesv)->sv_u.svu_pv)), SvCUR(namesv)((XPV*) (namesv)->sv_any)->xpv_cur, retval, seenhv,
903 postav, level+1, apad, style);
904 }
905 }
906 else if (realtype == SVt_PVGV) { /* glob ref */
907 SV * const namesv = newSVpvs("*{")Perl_newSVpvn( ("" "*{" ""), (sizeof("*{")-1));
908 sv_catpvn(namesv, name, namelen)Perl_sv_catpvn_flags( namesv,name,namelen,2);
909 sv_catpvs(namesv, "}")Perl_sv_catpvn_flags( namesv, ("" "}" ""), (sizeof("}")-1), 2
)
;
910 sv_catpvs(retval, "\\")Perl_sv_catpvn_flags( retval, ("" "\\" ""), (sizeof("\\")-1),
2)
;
911 DD_dump(aTHX_ ival, SvPVX_const(namesv)((const char*)(0 + (namesv)->sv_u.svu_pv)), SvCUR(namesv)((XPV*) (namesv)->sv_any)->xpv_cur, retval, seenhv,
912 postav, level+1, apad, style);
913 SvREFCNT_dec(namesv)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (namesv); _p; })));
914 }
915 else if (realtype == SVt_PVAV) {
916 SV *totpad;
917 SSize_tssize_t ix = 0;
918 const SSize_tssize_t ixmax = av_len((AV *)ival)Perl_av_len( (AV *)ival);
919
920 SV * const ixsv = sv_2mortal(newSViv(0))Perl_sv_2mortal( Perl_newSViv( 0));
921 /* allowing for a 24 char wide array index */
922 New(0, iname, namelen+28, char)(iname = ((void)(__builtin_expect(((((( sizeof(size_t) < sizeof
(namelen+28) || sizeof(char) > ((size_t)1 << 8*(sizeof
(size_t) - sizeof(namelen+28)))) ? (size_t)(namelen+28) : ((size_t
)-1)/sizeof(char)) > ((size_t)-1)/sizeof(char))) ? (_Bool)
1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap(),0)), (
char*)(Perl_safesysmalloc((size_t)((namelen+28)*sizeof(char))
))))
;
923 SAVEFREEPV(iname)Perl_save_pushptr( (void *)((char*)(iname)),10);
924 (void) strlcpy(iname, name, namelen+28)strlcpy(iname,name,namelen+28);
925 inamelen = namelen;
926 if (name[0] == '@') {
927 sv_catpvs(retval, "(")Perl_sv_catpvn_flags( retval, ("" "(" ""), (sizeof("(")-1), 2
)
;
928 iname[0] = '$';
929 }
930 else {
931 sv_catpvs(retval, "[")Perl_sv_catpvn_flags( retval, ("" "[" ""), (sizeof("[")-1), 2
)
;
932 /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
933 /*if (namelen > 0
934 && name[namelen-1] != ']' && name[namelen-1] != '}'
935 && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/
936 if ((namelen > 0
937 && name[namelen-1] != ']' && name[namelen-1] != '}')
938 || (namelen > 4
939 && (name[1] == '{'
940 || (name[0] == '\\' && name[2] == '{'))))
941 {
942 iname[inamelen++] = '-'; iname[inamelen++] = '>';
943 iname[inamelen] = '\0';
944 }
945 }
946 if (iname[0] == '*' && iname[inamelen-1] == '}' && inamelen >= 8 &&
947 (instr(iname+inamelen-8, "{SCALAR}")strstr(iname+inamelen-8, "{SCALAR}") ||
948 instr(iname+inamelen-7, "{ARRAY}")strstr(iname+inamelen-7, "{ARRAY}") ||
949 instr(iname+inamelen-6, "{HASH}")strstr(iname+inamelen-6, "{HASH}"))) {
950 iname[inamelen++] = '-'; iname[inamelen++] = '>';
951 }
952 iname[inamelen++] = '['; iname[inamelen] = '\0';
953 totpad = sv_2mortal(newSVsv(style->sep))Perl_sv_2mortal( Perl_newSVsv_flags( (style->sep),2|16));
954 sv_catsv(totpad, style->pad)Perl_sv_catsv_flags( totpad,style->pad,2);
955 sv_catsv(totpad, apad)Perl_sv_catsv_flags( totpad,apad,2);
956
957 for (ix = 0; ix <= ixmax; ++ix) {
958 STRLEN ilen;
959 SV *elem;
960 svp = av_fetch((AV*)ival, ix, FALSE)Perl_av_fetch( (AV*)ival,ix,(0));
961 if (svp)
962 elem = *svp;
963 else
964 elem = &PL_sv_undef(PL_sv_immortals[1]);
965
966 ilen = inamelen;
967 sv_setiv(ixsv, ix)Perl_sv_setiv( ixsv,ix);
968#if PERL_VERSION32 < 10
969 (void) sprintf(iname+ilen, "%" IVdf"ld", (IV)ix);
970 ilen = strlen(iname);
971#else
972 ilen = ilen + my_sprintfsprintf(iname+ilen, "%" IVdf"ld", (IV)ix);
973#endif
974 iname[ilen++] = ']'; iname[ilen] = '\0';
975 if (style->indent >= 3) {
976 sv_catsv(retval, totpad)Perl_sv_catsv_flags( retval,totpad,2);
977 sv_catsv(retval, ipad)Perl_sv_catsv_flags( retval,ipad,2);
978 sv_catpvs(retval, "#")Perl_sv_catpvn_flags( retval, ("" "#" ""), (sizeof("#")-1), 2
)
;
979 sv_catsv(retval, ixsv)Perl_sv_catsv_flags( retval,ixsv,2);
980 }
981 sv_catsv(retval, totpad)Perl_sv_catsv_flags( retval,totpad,2);
982 sv_catsv(retval, ipad)Perl_sv_catsv_flags( retval,ipad,2);
983 ENTERPerl_push_scope();
984 SAVETMPSPerl_savetmps();
985 DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
986 level+1, apad, style);
987 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
988 LEAVEPerl_pop_scope();
989 if (ix < ixmax || (style->trailingcomma && style->indent >= 1))
990 sv_catpvs(retval, ",")Perl_sv_catpvn_flags( retval, ("" "," ""), (sizeof(",")-1), 2
)
;
991 }
992 if (ixmax >= 0) {
993 SV * const opad = sv_x(aTHX_ Nullsv((SV*)((void*)0)), SvPVX_const(style->xpad)((const char*)(0 + (style->xpad)->sv_u.svu_pv)), SvCUR(style->xpad)((XPV*) (style->xpad)->sv_any)->xpv_cur, level);
994 sv_catsv(retval, totpad)Perl_sv_catsv_flags( retval,totpad,2);
995 sv_catsv(retval, opad)Perl_sv_catsv_flags( retval,opad,2);
996 SvREFCNT_dec(opad)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (opad); _p; })));
997 }
998 if (name[0] == '@')
999 sv_catpvs(retval, ")")Perl_sv_catpvn_flags( retval, ("" ")" ""), (sizeof(")")-1), 2
)
;
1000 else
1001 sv_catpvs(retval, "]")Perl_sv_catpvn_flags( retval, ("" "]" ""), (sizeof("]")-1), 2
)
;
1002 }
1003 else if (realtype == SVt_PVHV) {
1004 SV *totpad, *newapad;
1005 SV *sname;
1006 HE *entry = NULL((void*)0);
1007 char *key;
1008 SV *hval;
1009 AV *keys = NULL((void*)0);
1010
1011 SV * const iname = newSVpvn_flags(name, namelen, SVs_TEMP)Perl_newSVpvn_flags( name,namelen,0x00080000);
1012 if (name[0] == '%') {
1013 sv_catpvs(retval, "(")Perl_sv_catpvn_flags( retval, ("" "(" ""), (sizeof("(")-1), 2
)
;
1014 (SvPVX(iname)((iname)->sv_u.svu_pv))[0] = '$';
1015 }
1016 else {
1017 sv_catpvs(retval, "{")Perl_sv_catpvn_flags( retval, ("" "{" ""), (sizeof("{")-1), 2
)
;
1018 /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
1019 if ((namelen > 0
1020 && name[namelen-1] != ']' && name[namelen-1] != '}')
1021 || (namelen > 4
1022 && (name[1] == '{'
1023 || (name[0] == '\\' && name[2] == '{'))))
1024 {
1025 sv_catpvs(iname, "->")Perl_sv_catpvn_flags( iname, ("" "->" ""), (sizeof("->"
)-1), 2)
;
1026 }
1027 }
1028 if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
1029 (instr(name+namelen-8, "{SCALAR}")strstr(name+namelen-8, "{SCALAR}") ||
1030 instr(name+namelen-7, "{ARRAY}")strstr(name+namelen-7, "{ARRAY}") ||
1031 instr(name+namelen-6, "{HASH}")strstr(name+namelen-6, "{HASH}"))) {
1032 sv_catpvs(iname, "->")Perl_sv_catpvn_flags( iname, ("" "->" ""), (sizeof("->"
)-1), 2)
;
1033 }
1034 sv_catpvs(iname, "{")Perl_sv_catpvn_flags( iname, ("" "{" ""), (sizeof("{")-1), 2);
1035 totpad = sv_2mortal(newSVsv(style->sep))Perl_sv_2mortal( Perl_newSVsv_flags( (style->sep),2|16));
1036 sv_catsv(totpad, style->pad)Perl_sv_catsv_flags( totpad,style->pad,2);
1037 sv_catsv(totpad, apad)Perl_sv_catsv_flags( totpad,apad,2);
1038
1039 /* If requested, get a sorted/filtered array of hash keys */
1040 if (style->sortkeys) {
1041#if PERL_VERSION32 >= 8
1042 if (style->sortkeys == &PL_sv_yes(PL_sv_immortals[0])) {
1043 keys = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; }));
1044 (void)hv_iterinit((HV*)ival)Perl_hv_iterinit( (HV*)ival);
1045 while ((entry = hv_iternext((HV*)ival)Perl_hv_iternext_flags( (HV*)ival,0))) {
1046 sv = hv_iterkeysv(entry)Perl_hv_iterkeysv( entry);
1047 (void)SvREFCNT_inc(sv)Perl_SvREFCNT_inc(((SV *)({ void *_p = (sv); _p; })));
1048 av_push(keys, sv)Perl_av_push( keys,sv);
1049 }
1050# ifdef USE_LOCALE_COLLATE
1051# ifdef IN_LC /* Use this if available */
1052 if (IN_LC(LC_COLLATE)(( ((PL_compiling.cop_hints & 0x00000004) ? (_Bool)1 : (_Bool
)0) || ( ((PL_compiling.cop_hints & 0x00000010) ? (_Bool)
1 : (_Bool)0) && Perl__is_in_locale_category( (1), (1
)))) || ((PL_curcop && ((PL_curcop)->cop_hints + 0
) & 0x00000004) || ((PL_curcop && ((PL_curcop)->
cop_hints + 0) & 0x00000010) && Perl__is_in_locale_category
( (0), (1)))))
)
1053# else
1054 if (IN_LOCALE(((PL_curcop == &PL_compiling) ? (_Bool)1 : (_Bool)0) ? (
(PL_compiling.cop_hints & 0x00000004) ? (_Bool)1 : (_Bool
)0) : (PL_curcop && ((PL_curcop)->cop_hints + 0) &
0x00000004))
)
1055# endif
1056 {
1057 sortsv(AvARRAY(keys),Perl_sortsv( ((keys)->sv_u.svu_array),Perl_av_len( keys)+1
,Perl_sv_cmp_locale)
1058 av_len(keys)+1,Perl_sortsv( ((keys)->sv_u.svu_array),Perl_av_len( keys)+1
,Perl_sv_cmp_locale)
1059 Perl_sv_cmp_locale)Perl_sortsv( ((keys)->sv_u.svu_array),Perl_av_len( keys)+1
,Perl_sv_cmp_locale)
;
1060 }
1061 else
1062# endif
1063 {
1064 sortsv(AvARRAY(keys),Perl_sortsv( ((keys)->sv_u.svu_array),Perl_av_len( keys)+1
,Perl_sv_cmp)
1065 av_len(keys)+1,Perl_sortsv( ((keys)->sv_u.svu_array),Perl_av_len( keys)+1
,Perl_sv_cmp)
1066 Perl_sv_cmp)Perl_sortsv( ((keys)->sv_u.svu_array),Perl_av_len( keys)+1
,Perl_sv_cmp)
;
1067 }
1068 }
1069 else
1070#endif
1071 {
1072 dSPSV **sp = PL_stack_sp; ENTERPerl_push_scope(); SAVETMPSPerl_savetmps(); PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0)
;
1073 XPUSHs(sv_2mortal(newRV_inc(ival)))do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (Perl_sv_2mortal( Perl_newRV( ival))); } while (0)
; PUTBACKPL_stack_sp = sp;
1074 i = perl_call_sv(style->sortkeys, G_SCALAR | G_EVAL)Perl_call_sv( style->sortkeys,2 | 0x8);
1075 SPAGAINsp = PL_stack_sp;
1076 if (i) {
1077 sv = POPs(*sp--);
1078 if (SvROK(sv)((sv)->sv_flags & 0x00000800) && (SvTYPE(SvRV(sv))((svtype)((((sv)->sv_u.svu_rv))->sv_flags & 0xff)) == SVt_PVAV))
1079 keys = (AV*)SvREFCNT_inc(SvRV(sv))Perl_SvREFCNT_inc(((SV *)({ void *_p = (((sv)->sv_u.svu_rv
)); _p; })))
;
1080 }
1081 if (! keys)
1082 warnPerl_warn("Sortkeys subroutine did not return ARRAYREF\n");
1083 PUTBACKPL_stack_sp = sp; FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps(); LEAVEPerl_pop_scope();
1084 }
1085 if (keys)
1086 sv_2mortal((SV*)keys)Perl_sv_2mortal( (SV*)keys);
1087 }
1088 else
1089 (void)hv_iterinit((HV*)ival)Perl_hv_iterinit( (HV*)ival);
1090
1091 /* foreach (keys %hash) */
1092 for (i = 0; 1; i++) {
1093 char *nkey;
1094 char *nkey_buffer = NULL((void*)0);
1095 STRLEN nticks = 0;
1096 SV* keysv;
1097 STRLEN klen;
1098 STRLEN keylen;
1099 STRLEN nlen;
1100 bool_Bool do_utf8 = FALSE(0);
1101
1102 if (style->sortkeys) {
1103 if (!(keys && (SSize_tssize_t)i <= av_len(keys)Perl_av_len( keys))) break;
1104 } else {
1105 if (!(entry = hv_iternext((HV *)ival)Perl_hv_iternext_flags( (HV *)ival,0))) break;
1106 }
1107
1108 if (i)
1109 sv_catpvs(retval, ",")Perl_sv_catpvn_flags( retval, ("" "," ""), (sizeof(",")-1), 2
)
;
1110
1111 if (style->sortkeys) {
1112 char *key;
1113 svp = av_fetch(keys, i, FALSE)Perl_av_fetch( keys,i,(0));
1114 keysv = svp ? *svp : sv_newmortal()Perl_sv_newmortal();
1115 key = SvPV(keysv, keylen)((((keysv)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((keylen = ((XPV*) (keysv)->sv_any)->xpv_cur), ((keysv
)->sv_u.svu_pv)) : Perl_sv_2pv_flags( keysv,&keylen,2)
)
;
1116 svp = hv_fetch((HV*)ival, key,((SV**) Perl_hv_common_key_len( ((HV*)ival),(key),(((keysv)->
sv_flags & 0x20000000) ? -(I32)keylen : (I32)keylen),(0) ?
(0x20 | 0x10) : 0x20,((void*)0),0))
1117 SvUTF8(keysv) ? -(I32)keylen : (I32)keylen, 0)((SV**) Perl_hv_common_key_len( ((HV*)ival),(key),(((keysv)->
sv_flags & 0x20000000) ? -(I32)keylen : (I32)keylen),(0) ?
(0x20 | 0x10) : 0x20,((void*)0),0))
;
1118 hval = svp ? *svp : sv_newmortal()Perl_sv_newmortal();
1119 }
1120 else {
1121 keysv = hv_iterkeysv(entry)Perl_hv_iterkeysv( entry);
1122 hval = hv_iterval((HV*)ival, entry)Perl_hv_iterval( (HV*)ival,entry);
1123 }
1124
1125 key = SvPV(keysv, keylen)((((keysv)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((keylen = ((XPV*) (keysv)->sv_any)->xpv_cur), ((keysv
)->sv_u.svu_pv)) : Perl_sv_2pv_flags( keysv,&keylen,2)
)
;
1126 do_utf8 = DO_UTF8(keysv)(((keysv)->sv_flags & 0x20000000) && !__builtin_expect
(((((PL_curcop)->cop_hints + 0) & 0x00000008) ? (_Bool
)1 : (_Bool)0),(0)))
;
1127 klen = keylen;
1128
1129 sv_catsv(retval, totpad)Perl_sv_catsv_flags( retval,totpad,2);
1130 sv_catsv(retval, ipad)Perl_sv_catsv_flags( retval,ipad,2);
1131
1132 ENTERPerl_push_scope();
1133 SAVETMPSPerl_savetmps();
1134
1135 /* The (very)
1136 old logic was first to check utf8 flag, and if utf8 always
1137 call esc_q_utf8. This caused test to break under -Mutf8,
1138 because there even strings like 'c' have utf8 flag on.
1139 Hence with quotekeys == 0 the XS code would still '' quote
1140 them based on flags, whereas the perl code would not,
1141 based on regexps.
1142
1143 The old logic checked that the string was a valid
1144 perl glob name (foo::bar), which isn't safe under
1145 strict, and differs from the perl code which only
1146 accepts simple identifiers.
1147
1148 With the fix for [perl #120384] I chose to make
1149 their handling of key quoting compatible between XS
1150 and perl.
1151 */
1152 if (style->quotekeys || key_needs_quote(key,keylen)) {
1153 if (do_utf8 || style->useqq) {
1154 STRLEN ocur = SvCUR(retval)((XPV*) (retval)->sv_any)->xpv_cur;
1155 klen = nlen = esc_q_utf8(aTHX_ retval, key, klen, do_utf8, style->useqq);
1156 nkey = SvPVX(retval)((retval)->sv_u.svu_pv) + ocur;
1157 }
1158 else {
1159 nticks = num_q(key, klen);
1160 New(0, nkey_buffer, klen+nticks+3, char)(nkey_buffer = ((void)(__builtin_expect(((((( sizeof(size_t) <
sizeof(klen+nticks+3) || sizeof(char) > ((size_t)1 <<
8*(sizeof(size_t) - sizeof(klen+nticks+3)))) ? (size_t)(klen
+nticks+3) : ((size_t)-1)/sizeof(char)) > ((size_t)-1)/sizeof
(char))) ? (_Bool)1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap
(),0)), (char*)(Perl_safesysmalloc((size_t)((klen+nticks+3)*sizeof
(char))))))
;
1161 SAVEFREEPV(nkey_buffer)Perl_save_pushptr( (void *)((char*)(nkey_buffer)),10);
1162 nkey = nkey_buffer;
1163 nkey[0] = '\'';
1164 if (nticks)
1165 klen += esc_q(nkey+1, key, klen);
1166 else
1167 (void)Copy(key, nkey+1, klen, char)((void)(__builtin_expect(((((( sizeof(size_t) < sizeof(klen
) || sizeof(char) > ((size_t)1 << 8*(sizeof(size_t) -
sizeof(klen)))) ? (size_t)(klen) : ((size_t)-1)/sizeof(char)
) > ((size_t)-1)/sizeof(char))) ? (_Bool)1 : (_Bool)0),(0)
) && (Perl_croak_memory_wrap(),0)), ((void)0), ((void
)0), (void)memcpy((char*)(nkey+1),(const char*)(key), (klen) *
sizeof(char)))
;
1168 nkey[++klen] = '\'';
1169 nkey[++klen] = '\0';
1170 nlen = klen;
1171 sv_catpvn(retval, nkey, klen)Perl_sv_catpvn_flags( retval,nkey,klen,2);
1172 }
1173 }
1174 else {
1175 nkey = key;
1176 nlen = klen;
1177 sv_catpvn(retval, nkey, klen)Perl_sv_catpvn_flags( retval,nkey,klen,2);
1178 }
1179
1180 sname = sv_2mortal(newSVsv(iname))Perl_sv_2mortal( Perl_newSVsv_flags( (iname),2|16));
1181 sv_catpvn(sname, nkey, nlen)Perl_sv_catpvn_flags( sname,nkey,nlen,2);
1182 sv_catpvs(sname, "}")Perl_sv_catpvn_flags( sname, ("" "}" ""), (sizeof("}")-1), 2);
1183
1184 sv_catsv(retval, style->pair)Perl_sv_catsv_flags( retval,style->pair,2);
1185 if (style->indent >= 2) {
1186 char *extra;
1187 STRLEN elen = 0;
1188 newapad = sv_2mortal(newSVsv(apad))Perl_sv_2mortal( Perl_newSVsv_flags( (apad),2|16));
1189 New(0, extra, klen+4+1, char)(extra = ((void)(__builtin_expect(((((( sizeof(size_t) < sizeof
(klen+4+1) || sizeof(char) > ((size_t)1 << 8*(sizeof
(size_t) - sizeof(klen+4+1)))) ? (size_t)(klen+4+1) : ((size_t
)-1)/sizeof(char)) > ((size_t)-1)/sizeof(char))) ? (_Bool)
1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap(),0)), (
char*)(Perl_safesysmalloc((size_t)((klen+4+1)*sizeof(char))))
))
;
1190 while (elen < (klen+4))
1191 extra[elen++] = ' ';
1192 extra[elen] = '\0';
1193 sv_catpvn(newapad, extra, elen)Perl_sv_catpvn_flags( newapad,extra,elen,2);
1194 Safefree(extra)Perl_safesysfree(((void *)(extra)));
1195 }
1196 else
1197 newapad = apad;
1198
1199 DD_dump(aTHX_ hval, SvPVX_const(sname)((const char*)(0 + (sname)->sv_u.svu_pv)), SvCUR(sname)((XPV*) (sname)->sv_any)->xpv_cur, retval, seenhv,
1200 postav, level+1, newapad, style);
1201
1202 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
1203 LEAVEPerl_pop_scope();
1204 }
1205 if (i) {
1206 SV *opad = sv_x(aTHX_ Nullsv((SV*)((void*)0)), SvPVX_const(style->xpad)((const char*)(0 + (style->xpad)->sv_u.svu_pv)),
1207 SvCUR(style->xpad)((XPV*) (style->xpad)->sv_any)->xpv_cur, level);
1208 if (style->trailingcomma && style->indent >= 1)
1209 sv_catpvs(retval, ",")Perl_sv_catpvn_flags( retval, ("" "," ""), (sizeof(",")-1), 2
)
;
1210 sv_catsv(retval, totpad)Perl_sv_catsv_flags( retval,totpad,2);
1211 sv_catsv(retval, opad)Perl_sv_catsv_flags( retval,opad,2);
1212 SvREFCNT_dec(opad)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (opad); _p; })));
1213 }
1214 if (name[0] == '%')
1215 sv_catpvs(retval, ")")Perl_sv_catpvn_flags( retval, ("" ")" ""), (sizeof(")")-1), 2
)
;
1216 else
1217 sv_catpvs(retval, "}")Perl_sv_catpvn_flags( retval, ("" "}" ""), (sizeof("}")-1), 2
)
;
1218 }
1219 else if (realtype == SVt_PVCV) {
1220 if (style->deparse) {
1221 SV *deparsed = sv_2mortal(deparsed_output(aTHX_ val))Perl_sv_2mortal( deparsed_output( val));
1222 SV *fullpad = sv_2mortal(newSVsv(style->sep))Perl_sv_2mortal( Perl_newSVsv_flags( (style->sep),2|16));
1223 const char *p;
1224 STRLEN plen;
1225 I32 i;
1226
1227 sv_catsv(fullpad, style->pad)Perl_sv_catsv_flags( fullpad,style->pad,2);
1228 sv_catsv(fullpad, apad)Perl_sv_catsv_flags( fullpad,apad,2);
1229 for (i = 0; i < level; i++) {
1230 sv_catsv(fullpad, style->xpad)Perl_sv_catsv_flags( fullpad,style->xpad,2);
1231 }
1232
1233 sv_catpvs(retval, "sub ")Perl_sv_catpvn_flags( retval, ("" "sub " ""), (sizeof("sub ")
-1), 2)
;
1234 p = SvPV(deparsed, plen)((((deparsed)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((plen = ((XPV*) (deparsed)->sv_any)->xpv_cur), ((deparsed
)->sv_u.svu_pv)) : Perl_sv_2pv_flags( deparsed,&plen,2
))
;
1235 while (plen > 0) {
1236 const char *nl = (const char *) memchr(p, '\n', plen);
1237 if (!nl) {
1238 sv_catpvn(retval, p, plen)Perl_sv_catpvn_flags( retval,p,plen,2);
1239 break;
1240 }
1241 else {
1242 size_t n = nl - p;
1243 sv_catpvn(retval, p, n)Perl_sv_catpvn_flags( retval,p,n,2);
1244 sv_catsv(retval, fullpad)Perl_sv_catsv_flags( retval,fullpad,2);
1245 p += n + 1;
1246 plen -= n + 1;
1247 }
1248 }
1249 }
1250 else {
1251 sv_catpvs(retval, "sub { \"DUMMY\" }")Perl_sv_catpvn_flags( retval, ("" "sub { \"DUMMY\" }" ""), (sizeof
("sub { \"DUMMY\" }")-1), 2)
;
1252 if (style->purity)
1253 warnPerl_warn("Encountered CODE ref, using dummy placeholder");
1254 }
1255 }
1256 else {
1257 warnPerl_warn("cannot handle ref type %d", (int)realtype);
1258 }
1259
1260 if (realpack && !no_bless) { /* free blessed allocs */
1261 STRLEN plen, pticks;
1262
1263 if (style->indent >= 2) {
1264 apad = blesspad;
1265 }
1266 sv_catpvs(retval, ", '")Perl_sv_catpvn_flags( retval, ("" ", '" ""), (sizeof(", '")-1
), 2)
;
1267
1268 plen = strlen(realpack);
1269 pticks = num_q(realpack, plen);
1270 if (pticks) { /* needs escaping */
1271 char *npack;
1272 char *npack_buffer = NULL((void*)0);
1273
1274 New(0, npack_buffer, plen+pticks+1, char)(npack_buffer = ((void)(__builtin_expect(((((( sizeof(size_t)
< sizeof(plen+pticks+1) || sizeof(char) > ((size_t)1 <<
8*(sizeof(size_t) - sizeof(plen+pticks+1)))) ? (size_t)(plen
+pticks+1) : ((size_t)-1)/sizeof(char)) > ((size_t)-1)/sizeof
(char))) ? (_Bool)1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap
(),0)), (char*)(Perl_safesysmalloc((size_t)((plen+pticks+1)*sizeof
(char))))))
;
1275 npack = npack_buffer;
1276 plen += esc_q(npack, realpack, plen);
1277 npack[plen] = '\0';
1278
1279 sv_catpvn(retval, npack, plen)Perl_sv_catpvn_flags( retval,npack,plen,2);
1280 Safefree(npack_buffer)Perl_safesysfree(((void *)(npack_buffer)));
1281 }
1282 else {
1283 sv_catpvn(retval, realpack, strlen(realpack))Perl_sv_catpvn_flags( retval,realpack,strlen(realpack),2);
1284 }
1285 sv_catpvs(retval, "' )")Perl_sv_catpvn_flags( retval, ("" "' )" ""), (sizeof("' )")-1
), 2)
;
1286 if (style->toaster && SvPOK(style->toaster)((style->toaster)->sv_flags & 0x00000400) && SvCUR(style->toaster)((XPV*) (style->toaster)->sv_any)->xpv_cur) {
1287 sv_catpvs(retval, "->")Perl_sv_catpvn_flags( retval, ("" "->" ""), (sizeof("->"
)-1), 2)
;
1288 sv_catsv(retval, style->toaster)Perl_sv_catsv_flags( retval,style->toaster,2);
1289 sv_catpvs(retval, "()")Perl_sv_catpvn_flags( retval, ("" "()" ""), (sizeof("()")-1),
2)
;
1290 }
1291 }
1292 }
1293 else {
1294 STRLEN i;
1295 const MAGIC *mg;
1296
1297 if (namelen) {
1298#ifdef DD_USE_OLD_ID_FORMAT
1299 idlen = my_snprintf(id, sizeof(id), "0x%" UVxf, PTR2UV(val))({ int len = snprintf(id, sizeof(id), "0x%" "lx", (UV)(val));
do { if ((sizeof(id)) > 0 && (size_t)len > (sizeof
(id))) Perl_croak("panic: %s buffer overflow", "snprintf"); }
while (0); len; })
;
1300#else
1301 id_buffer = PTR2UV(val)(UV)(val);
1302 idlen = sizeof(id_buffer);
1303#endif
1304 if ((svp = hv_fetch(seenhv, id, idlen, FALSE)((SV**) Perl_hv_common_key_len( (seenhv),(id),(idlen),((0)) ?
(0x20 | 0x10) : 0x20,((void*)0),0))
) &&
1305 (sv = *svp) && SvROK(sv)((sv)->sv_flags & 0x00000800) &&
1306 (seenentry = (AV*)SvRV(sv)((sv)->sv_u.svu_rv)))
1307 {
1308 SV *othername;
1309 if ((svp = av_fetch(seenentry, 0, FALSE)Perl_av_fetch( seenentry,0,(0))) && (othername = *svp)
1310 && (svp = av_fetch(seenentry, 2, FALSE)Perl_av_fetch( seenentry,2,(0))) && *svp && SvIV(*svp)((((*svp)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (*svp)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( *svp,2))
> 0)
1311 {
1312 sv_catpvs(retval, "${")Perl_sv_catpvn_flags( retval, ("" "${" ""), (sizeof("${")-1),
2)
;
1313 sv_catsv(retval, othername)Perl_sv_catsv_flags( retval,othername,2);
1314 sv_catpvs(retval, "}")Perl_sv_catpvn_flags( retval, ("" "}" ""), (sizeof("}")-1), 2
)
;
1315 return 1;
1316 }
1317 }
1318 /* If we're allowed to keep only a sparse "seen" hash
1319 * (IOW, the user does not expect it to contain everything
1320 * after the dump, then only store in seen hash if the SV
1321 * ref count is larger than 1. If it's 1, then we know that
1322 * there is no other reference, duh. This is an optimization.
1323 * Note that we'd have to check for weak-refs, too, but this is
1324 * already the branch for non-refs only. */
1325 else if (val != &PL_sv_undef(PL_sv_immortals[1]) && (!style->use_sparse_seen_hash || SvREFCNT(val)(val)->sv_refcnt > 1)) {
1326 SV * const namesv = newSVpvs("\\")Perl_newSVpvn( ("" "\\" ""), (sizeof("\\")-1));
1327 sv_catpvn(namesv, name, namelen)Perl_sv_catpvn_flags( namesv,name,namelen,2);
1328 seenentry = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; }));
1329 av_push(seenentry, namesv)Perl_av_push( seenentry,namesv);
1330 av_push(seenentry, newRV_inc(val))Perl_av_push( seenentry,Perl_newRV( val));
1331 (void)hv_store(seenhv, id, idlen, newRV_inc((SV*)seenentry), 0)((SV**) Perl_hv_common_key_len( (seenhv),(id),(idlen),(0x04|0x20
),(Perl_newRV( (SV*)seenentry)),(0)))
;
1332 SvREFCNT_dec(seenentry)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (seenentry); _p; })));
1333 }
1334 }
1335
1336 if (DD_is_integer(val)((val)->sv_flags & 0x00000100)) {
1337 STRLEN len;
1338 if (SvIsUV(val)((val)->sv_flags & 0x80000000))
1339 len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%" UVuf, SvUV(val))({ int len = snprintf(tmpbuf, sizeof(tmpbuf), "%" "lu", ((((val
)->sv_flags & (0x00000100|0x80000000|0x00200000)) == (
0x00000100|0x80000000)) ? ((XPVUV*) (val)->sv_any)->xuv_u
.xivu_uv : Perl_sv_2uv_flags( val,2))); do { if ((sizeof(tmpbuf
)) > 0 && (size_t)len > (sizeof(tmpbuf))) Perl_croak
("panic: %s buffer overflow", "snprintf"); } while (0); len; }
)
;
1340 else
1341 len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%" IVdf, SvIV(val))({ int len = snprintf(tmpbuf, sizeof(tmpbuf), "%" "ld", ((((val
)->sv_flags & (0x00000100|0x00200000)) == 0x00000100) ?
((XPVIV*) (val)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( val,2))); do { if ((sizeof(tmpbuf)) > 0 && (size_t
)len > (sizeof(tmpbuf))) Perl_croak("panic: %s buffer overflow"
, "snprintf"); } while (0); len; })
;
1342 if (SvPOK(val)((val)->sv_flags & 0x00000400)) {
1343 /* Need to check to see if this is a string such as " 0".
1344 I'm assuming from sprintf isn't going to clash with utf8. */
1345 STRLEN pvlen;
1346 const char * const pv = SvPV(val, pvlen)((((val)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((pvlen = ((XPV*) (val)->sv_any)->xpv_cur), ((val)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( val,&pvlen,2))
;
1347 if (pvlen != len || memNE(pv, tmpbuf, len)(! (memcmp(((const void *) (pv)), ((const void *) (tmpbuf)), len
) == 0))
)
1348 goto integer_came_from_string;
1349 }
1350 if (len > 10) {
1351 /* Looks like we're on a 64 bit system. Make it a string so that
1352 if a 32 bit system reads the number it will cope better. */
1353 sv_catpvfPerl_sv_catpvf(retval, "'%s'", tmpbuf);
1354 } else
1355 sv_catpvn(retval, tmpbuf, len)Perl_sv_catpvn_flags( retval,tmpbuf,len,2);
1356 }
1357 else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
1358 c = SvPV(val, i)((((val)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((i = ((XPV*) (val)->sv_any)->xpv_cur), ((val)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( val,&i,2))
;
1359 if(i) ++c, --i; /* just get the name */
1360 if (memBEGINs(c, i, "main::")( (i) >= sizeof("main::") - 1 && (memcmp(((const void
*) (c)), ((const void *) ("" "main::" "")), sizeof("main::")
-1) == 0))
) {
1361 c += 4;
1362#if PERL_VERSION32 < 7
1363 if (i == 6 || (i == 7 && c[6] == '\0'))
1364#else
1365 if (i == 6)
1366#endif
1367 i = 0; else i -= 4;
1368 }
1369 if (globname_needs_quote(c,i)) {
1370 sv_grow(retval, SvCUR(retval)+3)Perl_sv_grow( retval,((XPV*) (retval)->sv_any)->xpv_cur
+3)
;
1371 r = SvPVX(retval)((retval)->sv_u.svu_pv)+SvCUR(retval)((XPV*) (retval)->sv_any)->xpv_cur;
1372 r[0] = '*'; r[1] = '{'; r[2] = 0;
1373 SvCUR_set(retval, SvCUR(retval)+2)do { ((void)0); ((void)0); ((void)0); (((XPV*) (retval)->sv_any
)->xpv_cur = (((XPV*) (retval)->sv_any)->xpv_cur+2))
; } while (0)
;
1374 i = 3 + esc_q_utf8(aTHX_ retval, c, i,
1375#ifdef GvNAMEUTF8
1376 !!GvNAMEUTF8(val)((*((unsigned char *)(((((XPVGV*)(val)->sv_any)->xiv_u.
xivu_namehek))->hek_key)+((((XPVGV*)(val)->sv_any)->
xiv_u.xivu_namehek))->hek_len+1)) & 0x01)
, style->useqq
1377#else
1378 0, style->useqq || globname_supra_ascii(c, i)
1379#endif
1380 );
1381 sv_grow(retval, SvCUR(retval)+2)Perl_sv_grow( retval,((XPV*) (retval)->sv_any)->xpv_cur
+2)
;
1382 r = SvPVX(retval)((retval)->sv_u.svu_pv)+SvCUR(retval)((XPV*) (retval)->sv_any)->xpv_cur;
1383 r[0] = '}'; r[1] = '\0';
1384 SvCUR_set(retval, SvCUR(retval)+1)do { ((void)0); ((void)0); ((void)0); (((XPV*) (retval)->sv_any
)->xpv_cur = (((XPV*) (retval)->sv_any)->xpv_cur+1))
; } while (0)
;
1385 r = r+1 - i;
1386 }
1387 else {
1388 sv_grow(retval, SvCUR(retval)+i+2)Perl_sv_grow( retval,((XPV*) (retval)->sv_any)->xpv_cur
+i+2)
;
1389 r = SvPVX(retval)((retval)->sv_u.svu_pv)+SvCUR(retval)((XPV*) (retval)->sv_any)->xpv_cur;
1390 r[0] = '*'; strlcpy(r+1, c, SvLEN(retval))strlcpy(r+1,c,((XPV*) (retval)->sv_any)->xpv_len_u.xpvlenu_len
)
;
1391 i++;
1392 SvCUR_set(retval, SvCUR(retval)+i)do { ((void)0); ((void)0); ((void)0); (((XPV*) (retval)->sv_any
)->xpv_cur = (((XPV*) (retval)->sv_any)->xpv_cur+i))
; } while (0)
;
1393 }
1394
1395 if (style->purity) {
1396 static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
1397 static const STRLEN sizes[] = { 8, 7, 6 };
1398 SV *e;
1399 SV * const nname = newSVpvs("")Perl_newSVpvn( ("" "" ""), (sizeof("")-1));
1400 SV * const newapad = newSVpvs("")Perl_newSVpvn( ("" "" ""), (sizeof("")-1));
1401 GV * const gv = (GV*)val;
1402 I32 j;
1403
1404 for (j=0; j<3; j++) {
1405 e = ((j == 0) ? GvSV(gv)((0+(gv)->sv_u.svu_gp)->gp_sv) : (j == 1) ? (SV*)GvAV(gv)((0+(gv)->sv_u.svu_gp)->gp_av) : (SV*)GvHV(gv)(((0+(gv)->sv_u.svu_gp))->gp_hv));
1406 if (!e)
1407 continue;
1408 if (j == 0 && !SvOK(e)((e)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000))
)
1409 continue;
1410
1411 {
1412 SV *postentry = newSVpvn(r,i)Perl_newSVpvn( r,i);
1413
1414 sv_setsv(nname, postentry)Perl_sv_setsv_flags( nname,postentry,2|0);
1415 sv_catpvn(nname, entries[j], sizes[j])Perl_sv_catpvn_flags( nname,entries[j],sizes[j],2);
1416 sv_catpvs(postentry, " = ")Perl_sv_catpvn_flags( postentry, ("" " = " ""), (sizeof(" = "
)-1), 2)
;
1417 av_push(postav, postentry)Perl_av_push( postav,postentry);
1418 e = newRV_inc(e)Perl_newRV( e);
1419
1420 SvCUR_set(newapad, 0)do { ((void)0); ((void)0); ((void)0); (((XPV*) (newapad)->
sv_any)->xpv_cur = (0)); } while (0)
;
1421 if (style->indent >= 2)
1422 (void)sv_x(aTHX_ newapad, " ", 1, SvCUR(postentry)((XPV*) (postentry)->sv_any)->xpv_cur);
1423
1424 DD_dump(aTHX_ e, SvPVX_const(nname)((const char*)(0 + (nname)->sv_u.svu_pv)), SvCUR(nname)((XPV*) (nname)->sv_any)->xpv_cur, postentry,
1425 seenhv, postav, 0, newapad, style);
1426 SvREFCNT_dec(e)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (e); _p; })));
1427 }
1428 }
1429
1430 SvREFCNT_dec(newapad)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (newapad); _p; })));
1431 SvREFCNT_dec(nname)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (nname); _p; })));
1432 }
1433 }
1434 else if (val == &PL_sv_undef(PL_sv_immortals[1]) || !SvOK(val)((val)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000))
) {
1435 sv_catpvs(retval, "undef")Perl_sv_catpvn_flags( retval, ("" "undef" ""), (sizeof("undef"
)-1), 2)
;
1436 }
1437#ifdef SvVOK
1438 else if (SvMAGICAL(val)((val)->sv_flags & (0x00200000|0x00400000|0x00800000)) && (mg = mg_findPerl_mg_find(val, 'V'))) {
1439# if !defined(PL_vtbl_vstring) && PERL_VERSION32 < 17
1440 SV * const vecsv = sv_newmortal()Perl_sv_newmortal();
1441# if PERL_VERSION32 < 10
1442 scan_vstring(mg->mg_ptr, vecsv);
1443# else
1444 scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv)Perl_scan_vstring( mg->mg_ptr,mg->mg_ptr + mg->mg_len
,vecsv)
;
1445# endif
1446 if (!sv_eq(vecsv, val)Perl_sv_eq_flags( vecsv,val,2)) goto integer_came_from_string;
1447# endif
1448 sv_catpvn(retval, (const char *)mg->mg_ptr, mg->mg_len)Perl_sv_catpvn_flags( retval,(const char *)mg->mg_ptr,mg->
mg_len,2)
;
1449 }
1450#endif
1451
1452 else {
1453 integer_came_from_string:
1454 c = SvPV(val, i)((((val)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((i = ((XPV*) (val)->sv_any)->xpv_cur), ((val)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( val,&i,2))
;
1455 /* the pure perl and XS non-qq outputs have historically been
1456 * different in this case, but for useqq, let's try to match
1457 * the pure perl code.
1458 * see [perl #74798]
1459 */
1460 if (style->useqq && safe_decimal_number(c, i)) {
1461 sv_catsv(retval, val)Perl_sv_catsv_flags( retval,val,2);
1462 }
1463 else if (DO_UTF8(val)(((val)->sv_flags & 0x20000000) && !__builtin_expect
(((((PL_curcop)->cop_hints + 0) & 0x00000008) ? (_Bool
)1 : (_Bool)0),(0)))
|| style->useqq)
1464 i += esc_q_utf8(aTHX_ retval, c, i, DO_UTF8(val)(((val)->sv_flags & 0x20000000) && !__builtin_expect
(((((PL_curcop)->cop_hints + 0) & 0x00000008) ? (_Bool
)1 : (_Bool)0),(0)))
, style->useqq);
1465 else {
1466 sv_grow(retval, SvCUR(retval)+3+2*i)Perl_sv_grow( retval,((XPV*) (retval)->sv_any)->xpv_cur
+3+2*i)
; /* 3: ""\0 */
1467 r = SvPVX(retval)((retval)->sv_u.svu_pv) + SvCUR(retval)((XPV*) (retval)->sv_any)->xpv_cur;
1468 r[0] = '\'';
1469 i += esc_q(r+1, c, i);
1470 ++i;
1471 r[i++] = '\'';
1472 r[i] = '\0';
1473 SvCUR_set(retval, SvCUR(retval)+i)do { ((void)0); ((void)0); ((void)0); (((XPV*) (retval)->sv_any
)->xpv_cur = (((XPV*) (retval)->sv_any)->xpv_cur+i))
; } while (0)
;
1474 }
1475 }
1476 }
1477
1478 if (idlen) {
1479 if (style->deepcopy)
1480 (void)hv_delete(seenhv, id, idlen, G_DISCARD)(((SV *)({ void *_p = (Perl_hv_common_key_len( (seenhv),(id),
(idlen),(0x4) | 0x40,((void*)0),0)); _p; })))
;
1481 else if (namelen && seenentry) {
1482 SV *mark = *av_fetch(seenentry, 2, TRUE)Perl_av_fetch( seenentry,2,(1));
1483 sv_setiv(mark,1)Perl_sv_setiv( mark,1);
1484 }
1485 }
1486 return 1;
1487}
1488
1489
1490#line 1491 "Dumper.c"
1491#ifndef PERL_UNUSED_VAR
1492# define PERL_UNUSED_VAR(var)((void)sizeof(var)) if (0) var = var
1493#endif
1494
1495#ifndef dVARstruct Perl___notused_struct
1496# define dVARstruct Perl___notused_struct dNOOPstruct Perl___notused_struct
1497#endif
1498
1499
1500/* This stuff is not part of the API! You have been warned. */
1501#ifndef PERL_VERSION_DECIMAL
1502# define PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s) (r*1000000 + v*1000 + s)
1503#endif
1504#ifndef PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1)
1505# define PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) \
1506 PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)(5*1000000 + 32*1000 + 1)
1507#endif
1508#ifndef PERL_VERSION_GE
1509# define PERL_VERSION_GE(r,v,s)((5*1000000 + 32*1000 + 1) >= (r*1000000 + v*1000 + s)) \
1510 (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) >= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s))
1511#endif
1512#ifndef PERL_VERSION_LE
1513# define PERL_VERSION_LE(r,v,s)((5*1000000 + 32*1000 + 1) <= (r*1000000 + v*1000 + s)) \
1514 (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) <= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s))
1515#endif
1516
1517/* XS_INTERNAL is the explicit static-linkage variant of the default
1518 * XS macro.
1519 *
1520 * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
1521 * "STATIC", ie. it exports XSUB symbols. You probably don't want that
1522 * for anything but the BOOT XSUB.
1523 *
1524 * See XSUB.h in core!
1525 */
1526
1527
1528/* TODO: This might be compatible further back than 5.10.0. */
1529#if PERL_VERSION_GE(5, 10, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 10*1000 + 0)) && PERL_VERSION_LE(5, 15, 1)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 15*1000 + 1))
1530# undef XS_EXTERNAL
1531# undef XS_INTERNAL
1532# if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
1533# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) __declspec(dllexport) XSPROTO(name)void name( CV* cv __attribute__((unused)))
1534# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused)))
1535# endif
1536# if defined(__SYMBIAN32__)
1537# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) EXPORT_C XSPROTO(name)void name( CV* cv __attribute__((unused)))
1538# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) EXPORT_C STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused)))
1539# endif
1540# ifndef XS_EXTERNAL
1541# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
1542# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) void name(pTHX_ CV* cv __attribute__unused____attribute__((unused)))
1543# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic void name(pTHX_ CV* cv __attribute__unused____attribute__((unused)))
1544# else
1545# ifdef __cplusplus
1546# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) extern "C" XSPROTO(name)void name( CV* cv __attribute__((unused)))
1547# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) static XSPROTO(name)void name( CV* cv __attribute__((unused)))
1548# else
1549# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XSPROTO(name)void name( CV* cv __attribute__((unused)))
1550# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused)))
1551# endif
1552# endif
1553# endif
1554#endif
1555
1556/* perl >= 5.10.0 && perl <= 5.15.1 */
1557
1558
1559/* The XS_EXTERNAL macro is used for functions that must not be static
1560 * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
1561 * macro defined, the best we can do is assume XS is the same.
1562 * Dito for XS_INTERNAL.
1563 */
1564#ifndef XS_EXTERNAL
1565# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused)))
1566#endif
1567#ifndef XS_INTERNAL
1568# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused)))
1569#endif
1570
1571/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
1572 * internal macro that we're free to redefine for varying linkage due
1573 * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
1574 * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
1575 */
1576
1577#undef XS_EUPXS
1578#if defined(PERL_EUPXS_ALWAYS_EXPORT)
1579# define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_EXTERNAL(name)void name( CV* cv __attribute__((unused)))
1580#else
1581 /* default to internal */
1582# define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_INTERNAL(name)static void name( CV* cv __attribute__((unused)))
1583#endif
1584
1585#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0)
1586#define PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) assert(cv)((void)0); assert(params)((void)0)
1587
1588/* prototype to pass -Wmissing-prototypes */
1589STATICstatic void
1590S_croak_xs_usage(const CV *const cv, const char *const params);
1591
1592STATICstatic void
1593S_croak_xs_usage(const CV *const cv, const char *const params)
1594{
1595 const GV *const gv = CvGV(cv)Perl_CvGV( (CV *)(cv));
1596
1597 PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0);
1598
1599 if (gv) {
1600 const char *const gvname = GvNAME(gv)((((XPVGV*)(gv)->sv_any)->xiv_u.xivu_namehek))->hek_key;
1601 const HV *const stash = GvSTASH(gv)(((XPVGV*)(gv)->sv_any)->xnv_u.xgv_stash);
1602 const char *const hvname = stash ? HvNAME(stash)((((stash)->sv_flags & 0x02000000) && ((struct
xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV*) (stash
)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name &&
( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_count ? *
((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names
: ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name
)) ? (( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash
)[((XPVHV*) (stash)->sv_any)->xhv_max+1]))->xhv_name_count
? *((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names
: ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name
))->hek_key : ((void*)0))
: NULL((void*)0);
1603
1604 if (hvname)
1605 Perl_croak_nocontextPerl_croak("Usage: %s::%s(%s)", hvname, gvname, params);
1606 else
1607 Perl_croak_nocontextPerl_croak("Usage: %s(%s)", gvname, params);
1608 } else {
1609 /* Pants. I don't think that it should be possible to get here. */
1610 Perl_croak_nocontextPerl_croak("Usage: CODE(0x%" UVxf"lx" ")(%s)", PTR2UV(cv)(UV)(cv), params);
1611 }
1612}
1613#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0)
1614
1615#define croak_xs_usagePerl_croak_xs_usage S_croak_xs_usage
1616
1617#endif
1618
1619/* NOTE: the prototype of newXSproto() is different in versions of perls,
1620 * so we define a portable version of newXSproto()
1621 */
1622#ifdef newXS_flags
1623#define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) newXS_flags(name, c_impl, file, proto, 0)Perl_newXS_flags( name,c_impl,file,proto,0)
1624#else
1625#define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) (PL_Sv=(SV*)newXS(name, c_impl, file)Perl_newXS( name,c_impl,file), sv_setpv(PL_Sv, proto)Perl_sv_setpv( PL_Sv,proto), (CV*)PL_Sv)
1626#endif /* !defined(newXS_flags) */
1627
1628#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
1629# define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS(aTHX_ a,b,file)
1630#else
1631# define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS_deffile(aTHX_ a,b)
1632#endif
1633
1634#line 1635 "Dumper.c"
1635
1636XS_EUPXS(XS_Data__Dumper_Dumpxs)static void XS_Data__Dumper_Dumpxs( CV* cv __attribute__((unused
)))
; /* prototype to pass -Wmissing-prototypes */
1637XS_EUPXS(XS_Data__Dumper_Dumpxs)static void XS_Data__Dumper_Dumpxs( CV* cv __attribute__((unused
)))
1638{
1639 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark)
;
1640 if (items < 1)
1641 croak_xs_usagePerl_croak_xs_usage(cv, "href, ...");
1642 PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */
1643 SPsp -= items;
1644 {
1645 SV * href = ST(0)PL_stack_base[ax + (0)]
1646;
1647#line 1494 "Dumper.xs"
1648 {
1649 HV *hv;
1650 SV *retval, *valstr;
1651 HV *seenhv = NULL((void*)0);
1652 AV *postav, *todumpav, *namesav;
1653 I32 terse = 0;
1654 SSize_tssize_t i, imax, postlen;
1655 SV **svp;
1656 SV *apad = &PL_sv_undef(PL_sv_immortals[1]);
1657 Style style;
1658
1659 SV *name, *val = &PL_sv_undef(PL_sv_immortals[1]), *varname = &PL_sv_undef(PL_sv_immortals[1]);
1660 char tmpbuf[1024];
1661 I32 gimme = GIMME_VPerl_gimme_V();
1662
1663 if (!SvROK(href)((href)->sv_flags & 0x00000800)) { /* call new to get an object first */
1664 if (items < 2)
1665 croakPerl_croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
1666
1667 ENTERPerl_push_scope();
1668 SAVETMPSPerl_savetmps();
1669
1670 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0)
;
1671 EXTEND(SP, 3)do { (void)0; if (__builtin_expect(((((3) < 0 || PL_stack_max
- (sp) < (3))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(3) > sizeof(ssize_t) && ((ssize_t)
(3) != (3)) ? -1 : (3))); ((void)sizeof(sp)); } } while (0)
; /* 3 == max of all branches below */
1672 PUSHs(href)(*++sp = (href));
1673 PUSHs(sv_2mortal(newSVsv(ST(1))))(*++sp = (Perl_sv_2mortal( Perl_newSVsv_flags( (PL_stack_base
[ax + (1)]),2|16))))
;
1674 if (items >= 3)
1675 PUSHs(sv_2mortal(newSVsv(ST(2))))(*++sp = (Perl_sv_2mortal( Perl_newSVsv_flags( (PL_stack_base
[ax + (2)]),2|16))))
;
1676 PUTBACKPL_stack_sp = sp;
1677 i = perl_call_method("new", G_SCALAR)Perl_call_method( "new",2);
1678 SPAGAINsp = PL_stack_sp;
1679 if (i)
1680 href = newSVsv(POPs)Perl_newSVsv_flags( ((*sp--)),2|16);
1681
1682 PUTBACKPL_stack_sp = sp;
1683 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
1684 LEAVEPerl_pop_scope();
1685 if (i)
1686 (void)sv_2mortal(href)Perl_sv_2mortal( href);
1687 }
1688
1689 todumpav = namesav = NULL((void*)0);
1690 style.indent = 2;
1691 style.quotekeys = 1;
1692 style.maxrecurse = 1000;
1693 style.maxrecursed = FALSE(0);
1694 style.purity = style.deepcopy = style.useqq = style.maxdepth
1695 = style.use_sparse_seen_hash = style.trailingcomma = 0;
1696 style.pad = style.xpad = style.sep = style.pair = style.sortkeys
1697 = style.freezer = style.toaster = style.bless = &PL_sv_undef(PL_sv_immortals[1]);
1698 seenhv = NULL((void*)0);
1699 name = sv_newmortal()Perl_sv_newmortal();
1700
1701 retval = newSVpvs_flags("", SVs_TEMP)Perl_newSVpvn_flags( ("" "" ""), (sizeof("")-1), 0x00080000);
1702 if (SvROK(href)((href)->sv_flags & 0x00000800)
1703 && (hv = (HV*)SvRV((SV*)href)(((SV*)href)->sv_u.svu_rv))
1704 && SvTYPE(hv)((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV) {
1705
1706 if ((svp = hv_fetchs(hv, "seen", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "seen" "")),((sizeof
("seen")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
) && SvROK(*svp)((*svp)->sv_flags & 0x00000800))
1707 seenhv = (HV*)SvRV(*svp)((*svp)->sv_u.svu_rv);
1708 else
1709 style.use_sparse_seen_hash = 1;
1710 if ((svp = hv_fetchs(hv, "noseen", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "noseen" "")),((sizeof
("noseen")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1711 style.use_sparse_seen_hash = (SvOK(*svp)((*svp)->sv_flags & (0x00000100|0x00000200|0x00000400|
0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000))
&& SvIV(*svp)((((*svp)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (*svp)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( *svp,2))
!= 0);
1712 if ((svp = hv_fetchs(hv, "todump", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "todump" "")),((sizeof
("todump")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
) && SvROK(*svp)((*svp)->sv_flags & 0x00000800))
1713 todumpav = (AV*)SvRV(*svp)((*svp)->sv_u.svu_rv);
1714 if ((svp = hv_fetchs(hv, "names", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "names" "")),((sizeof
("names")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
) && SvROK(*svp)((*svp)->sv_flags & 0x00000800))
1715 namesav = (AV*)SvRV(*svp)((*svp)->sv_u.svu_rv);
1716 if ((svp = hv_fetchs(hv, "indent", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "indent" "")),((sizeof
("indent")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1717 style.indent = SvIV(*svp)((((*svp)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (*svp)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( *svp,2))
;
1718 if ((svp = hv_fetchs(hv, "purity", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "purity" "")),((sizeof
("purity")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1719 style.purity = SvIV(*svp)((((*svp)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (*svp)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( *svp,2))
;
1720 if ((svp = hv_fetchs(hv, "terse", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "terse" "")),((sizeof
("terse")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1721 terse = SvTRUE(*svp)Perl_SvTRUE( *svp);
1722 if ((svp = hv_fetchs(hv, "useqq", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "useqq" "")),((sizeof
("useqq")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1723 style.useqq = SvTRUE(*svp)Perl_SvTRUE( *svp);
1724 if ((svp = hv_fetchs(hv, "pad", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "pad" "")),((sizeof
("pad")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1725 style.pad = *svp;
1726 if ((svp = hv_fetchs(hv, "xpad", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "xpad" "")),((sizeof
("xpad")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1727 style.xpad = *svp;
1728 if ((svp = hv_fetchs(hv, "apad", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "apad" "")),((sizeof
("apad")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1729 apad = *svp;
1730 if ((svp = hv_fetchs(hv, "sep", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "sep" "")),((sizeof
("sep")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1731 style.sep = *svp;
1732 if ((svp = hv_fetchs(hv, "pair", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "pair" "")),((sizeof
("pair")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1733 style.pair = *svp;
1734 if ((svp = hv_fetchs(hv, "varname", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "varname" "")),((
sizeof("varname")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)
0),0))
))
1735 varname = *svp;
1736 if ((svp = hv_fetchs(hv, "freezer", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "freezer" "")),((
sizeof("freezer")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)
0),0))
))
1737 style.freezer = *svp;
1738 if ((svp = hv_fetchs(hv, "toaster", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "toaster" "")),((
sizeof("toaster")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)
0),0))
))
1739 style.toaster = *svp;
1740 if ((svp = hv_fetchs(hv, "deepcopy", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "deepcopy" "")),(
(sizeof("deepcopy")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void
*)0),0))
))
1741 style.deepcopy = SvTRUE(*svp)Perl_SvTRUE( *svp);
1742 if ((svp = hv_fetchs(hv, "quotekeys", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "quotekeys" "")),
((sizeof("quotekeys")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void
*)0),0))
))
1743 style.quotekeys = SvTRUE(*svp)Perl_SvTRUE( *svp);
1744 if ((svp = hv_fetchs(hv, "trailingcomma", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "trailingcomma" ""
)),((sizeof("trailingcomma")-1)),(((0))) ? (0x20 | 0x10) : 0x20
,((void*)0),0))
))
1745 style.trailingcomma = SvTRUE(*svp)Perl_SvTRUE( *svp);
1746 if ((svp = hv_fetchs(hv, "deparse", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "deparse" "")),((
sizeof("deparse")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)
0),0))
))
1747 style.deparse = SvTRUE(*svp)Perl_SvTRUE( *svp);
1748 if ((svp = hv_fetchs(hv, "bless", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "bless" "")),((sizeof
("bless")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void*)0),0))
))
1749 style.bless = *svp;
1750 if ((svp = hv_fetchs(hv, "maxdepth", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "maxdepth" "")),(
(sizeof("maxdepth")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void
*)0),0))
))
1751 style.maxdepth = SvIV(*svp)((((*svp)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (*svp)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( *svp,2))
;
1752 if ((svp = hv_fetchs(hv, "maxrecurse", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "maxrecurse" ""))
,((sizeof("maxrecurse")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((
void*)0),0))
))
1753 style.maxrecurse = SvIV(*svp)((((*svp)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (*svp)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( *svp,2))
;
1754 if ((svp = hv_fetchs(hv, "sortkeys", FALSE)((SV**) Perl_hv_common_key_len( ((hv)),(("" "sortkeys" "")),(
(sizeof("sortkeys")-1)),(((0))) ? (0x20 | 0x10) : 0x20,((void
*)0),0))
)) {
1755 SV *sv = *svp;
1756 if (! SvTRUE(sv)Perl_SvTRUE( sv))
1757 style.sortkeys = NULL((void*)0);
1758 else if (SvROK(sv)((sv)->sv_flags & 0x00000800) && SvTYPE(SvRV(sv))((svtype)((((sv)->sv_u.svu_rv))->sv_flags & 0xff)) == SVt_PVCV)
1759 style.sortkeys = sv;
1760 else if (PERL_VERSION32 < 8)
1761 /* 5.6 doesn't make sortsv() available to XS code,
1762 * so we must use this helper instead. Note that we
1763 * always allocate this mortal SV, but it will be
1764 * used only if at least one hash is encountered
1765 * while dumping recursively; an older version
1766 * allocated it lazily as needed. */
1767 style.sortkeys = sv_2mortal(newSVpvs("Data::Dumper::_sortkeys"))Perl_sv_2mortal( Perl_newSVpvn( ("" "Data::Dumper::_sortkeys"
""), (sizeof("Data::Dumper::_sortkeys")-1)))
;
1768 else
1769 /* flag to use sortsv() for sorting hash keys */
1770 style.sortkeys = &PL_sv_yes(PL_sv_immortals[0]);
1771 }
1772 postav = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; }));
1773 sv_2mortal((SV*)postav)Perl_sv_2mortal( (SV*)postav);
1774
1775 if (todumpav)
1776 imax = av_len(todumpav)Perl_av_len( todumpav);
1777 else
1778 imax = -1;
1779 valstr = newSVpvs_flags("", SVs_TEMP)Perl_newSVpvn_flags( ("" "" ""), (sizeof("")-1), 0x00080000);
1780 for (i = 0; i <= imax; ++i) {
1781 SV *newapad;
1782
1783 av_clear(postav)Perl_av_clear( postav);
1784 if ((svp = av_fetch(todumpav, i, FALSE)Perl_av_fetch( todumpav,i,(0))))
1785 val = *svp;
1786 else
1787 val = &PL_sv_undef(PL_sv_immortals[1]);
1788 if ((svp = av_fetch(namesav, i, TRUE)Perl_av_fetch( namesav,i,(1)))) {
1789 sv_setsv(name, *svp)Perl_sv_setsv_flags( name,*svp,2|0);
1790 if (SvOK(*svp)((*svp)->sv_flags & (0x00000100|0x00000200|0x00000400|
0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000))
&& !SvPOK(*svp)((*svp)->sv_flags & 0x00000400))
1791 (void)SvPV_nolen_const(name)((((name)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((const char*)(0 + (name)->sv_u.svu_pv)) : Perl_sv_2pv_flags
( name,0,2|32))
;
1792 }
1793 else
1794 (void)SvOK_off(name)( (name)->sv_flags &= ~((0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000
|0x20000000), ((void)(((name)->sv_flags & 0x02000000) &&
(Perl_sv_backoff(name),0))))
;
1795
1796 if (SvPOK(name)((name)->sv_flags & 0x00000400)) {
1797 if ((SvPVX_const(name)((const char*)(0 + (name)->sv_u.svu_pv)))[0] == '*') {
1798 if (SvROK(val)((val)->sv_flags & 0x00000800)) {
1799 switch (SvTYPE(SvRV(val))((svtype)((((val)->sv_u.svu_rv))->sv_flags & 0xff))) {
1800 case SVt_PVAV:
1801 (SvPVX(name)((name)->sv_u.svu_pv))[0] = '@';
1802 break;
1803 case SVt_PVHV:
1804 (SvPVX(name)((name)->sv_u.svu_pv))[0] = '%';
1805 break;
1806 case SVt_PVCV:
1807 (SvPVX(name)((name)->sv_u.svu_pv))[0] = '*';
1808 break;
1809 default:
1810 (SvPVX(name)((name)->sv_u.svu_pv))[0] = '$';
1811 break;
1812 }
1813 }
1814 else
1815 (SvPVX(name)((name)->sv_u.svu_pv))[0] = '$';
1816 }
1817 else if ((SvPVX_const(name)((const char*)(0 + (name)->sv_u.svu_pv)))[0] != '$')
1818 sv_insert(name, 0, 0, "$", 1)Perl_sv_insert_flags( (name),(0), (0), ("$"), (1), 2);
1819 }
1820 else {
1821 STRLEN nchars;
1822 sv_setpvs(name, "$")Perl_sv_setpvn( name, ("" "$" ""), (sizeof("$")-1));
1823 sv_catsv(name, varname)Perl_sv_catsv_flags( name,varname,2);
1824 nchars = my_snprintf(tmpbuf, sizeof(tmpbuf), "%" IVdf,({ int len = snprintf(tmpbuf, sizeof(tmpbuf), "%" "ld", (IV)(
i+1)); do { if ((sizeof(tmpbuf)) > 0 && (size_t)len
> (sizeof(tmpbuf))) Perl_croak("panic: %s buffer overflow"
, "snprintf"); } while (0); len; })
1825 (IV)(i+1))({ int len = snprintf(tmpbuf, sizeof(tmpbuf), "%" "ld", (IV)(
i+1)); do { if ((sizeof(tmpbuf)) > 0 && (size_t)len
> (sizeof(tmpbuf))) Perl_croak("panic: %s buffer overflow"
, "snprintf"); } while (0); len; })
;
1826 sv_catpvn(name, tmpbuf, nchars)Perl_sv_catpvn_flags( name,tmpbuf,nchars,2);
1827 }
1828
1829 if (style.indent >= 2 && !terse) {
1830 SV * const tmpsv = sv_x(aTHX_ NULL((void*)0), " ", 1, SvCUR(name)((XPV*) (name)->sv_any)->xpv_cur+3);
1831 newapad = sv_2mortal(newSVsv(apad))Perl_sv_2mortal( Perl_newSVsv_flags( (apad),2|16));
1832 sv_catsv(newapad, tmpsv)Perl_sv_catsv_flags( newapad,tmpsv,2);
1833 SvREFCNT_dec(tmpsv)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (tmpsv); _p; })));
1834 }
1835 else
1836 newapad = apad;
1837
1838 ENTERPerl_push_scope();
1839 SAVETMPSPerl_savetmps();
1840 PUTBACKPL_stack_sp = sp;
1841 DD_dump(aTHX_ val, SvPVX_const(name)((const char*)(0 + (name)->sv_u.svu_pv)), SvCUR(name)((XPV*) (name)->sv_any)->xpv_cur, valstr, seenhv,
1842 postav, 0, newapad, &style);
1843 SPAGAINsp = PL_stack_sp;
1844 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
1845 LEAVEPerl_pop_scope();
1846
1847 postlen = av_len(postav)Perl_av_len( postav);
1848 if (postlen >= 0 || !terse) {
1849 sv_insert(valstr, 0, 0, " = ", 3)Perl_sv_insert_flags( (valstr),(0), (0), (" = "), (3), 2);
1850 sv_insert(valstr, 0, 0, SvPVX_const(name), SvCUR(name))Perl_sv_insert_flags( (valstr),(0), (0), (((const char*)(0 + (
name)->sv_u.svu_pv))), (((XPV*) (name)->sv_any)->xpv_cur
), 2)
;
1851 sv_catpvs(valstr, ";")Perl_sv_catpvn_flags( valstr, ("" ";" ""), (sizeof(";")-1), 2
)
;
1852 }
1853 sv_catsv(retval, style.pad)Perl_sv_catsv_flags( retval,style.pad,2);
1854 sv_catsv(retval, valstr)Perl_sv_catsv_flags( retval,valstr,2);
1855 sv_catsv(retval, style.sep)Perl_sv_catsv_flags( retval,style.sep,2);
1856 if (postlen >= 0) {
1857 SSize_tssize_t i;
1858 sv_catsv(retval, style.pad)Perl_sv_catsv_flags( retval,style.pad,2);
1859 for (i = 0; i <= postlen; ++i) {
1860 SV *elem;
1861 svp = av_fetch(postav, i, FALSE)Perl_av_fetch( postav,i,(0));
1862 if (svp && (elem = *svp)) {
1863 sv_catsv(retval, elem)Perl_sv_catsv_flags( retval,elem,2);
1864 if (i < postlen) {
1865 sv_catpvs(retval, ";")Perl_sv_catpvn_flags( retval, ("" ";" ""), (sizeof(";")-1), 2
)
;
1866 sv_catsv(retval, style.sep)Perl_sv_catsv_flags( retval,style.sep,2);
1867 sv_catsv(retval, style.pad)Perl_sv_catsv_flags( retval,style.pad,2);
1868 }
1869 }
1870 }
1871 sv_catpvs(retval, ";")Perl_sv_catpvn_flags( retval, ("" ";" ""), (sizeof(";")-1), 2
)
;
1872 sv_catsv(retval, style.sep)Perl_sv_catsv_flags( retval,style.sep,2);
1873 }
1874 SvPVCLEAR(valstr)Perl_sv_setpv_bufsize( valstr,0,0);
1875 if (gimme == G_ARRAY3) {
1876 XPUSHs(retval)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (retval); } while (0)
;
1877 if (i < imax) /* not the last time thro ? */
1878 retval = newSVpvs_flags("", SVs_TEMP)Perl_newSVpvn_flags( ("" "" ""), (sizeof("")-1), 0x00080000);
1879 }
1880 }
1881
1882 /* we defer croaking until here so that temporary SVs and
1883 * buffers won't be leaked */
1884 if (style.maxrecursed)
1885 croakPerl_croak("Recursion limit of %" IVdf"ld" " exceeded",
1886 style.maxrecurse);
1887
1888 }
1889 else
1890 croakPerl_croak("Call to new() method failed to return HASH ref");
1891 if (gimme != G_ARRAY3)
1892 XPUSHs(retval)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (retval); } while (0)
;
1893 }
1894#line 1895 "Dumper.c"
1895 PUTBACKPL_stack_sp = sp;
1896 return;
1897 }
1898}
1899
1900
1901XS_EUPXS(XS_Data__Dumper__vstring)static void XS_Data__Dumper__vstring( CV* cv __attribute__((unused
)))
; /* prototype to pass -Wmissing-prototypes */
1902XS_EUPXS(XS_Data__Dumper__vstring)static void XS_Data__Dumper__vstring( CV* cv __attribute__((unused
)))
1903{
1904 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark)
;
1905 if (items != 1)
1906 croak_xs_usagePerl_croak_xs_usage(cv, "sv");
1907 {
1908 SV * sv = ST(0)PL_stack_base[ax + (0)]
1909;
1910 SV * RETVAL;
1911#line 1746 "Dumper.xs"
1912 {
1913#ifdef SvVOK
1914 const MAGIC *mg;
1915 RETVAL =
1916 SvMAGICAL(sv)((sv)->sv_flags & (0x00200000|0x00400000|0x00800000)) && (mg = mg_findPerl_mg_find(sv, 'V'))
1917 ? newSVpvn((const char *)mg->mg_ptr, mg->mg_len)Perl_newSVpvn( (const char *)mg->mg_ptr,mg->mg_len)
1918 : &PL_sv_undef(PL_sv_immortals[1]);
1919#else
1920 RETVAL = &PL_sv_undef(PL_sv_immortals[1]);
1921#endif
1922 }
1923#line 1924 "Dumper.c"
1924 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1925 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1926 }
1927 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0)
;
1928}
1929
1930#ifdef __cplusplus
1931extern "C"
1932#endif
1933XS_EXTERNAL(boot_Data__Dumper)void boot_Data__Dumper( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */
1934XS_EXTERNAL(boot_Data__Dumper)void boot_Data__Dumper( CV* cv __attribute__((unused)))
1935{
1936#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
1937 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark)
;
1938#else
1939 dVARstruct Perl___notused_struct; dXSBOOTARGSXSAPIVERCHKI32 ax = Perl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter
)) << 16) | ((sizeof("" "2.174_01" "")-1) > 0xFF ? (
Perl_croak("panic: handshake overflow"), 0xFF) : (sizeof("" "2.174_01"
"")-1) << 8) | ((((1)) ? (_Bool)1 : (_Bool)0) ? 0x00000020
: 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((
((1)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v"
"5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1)))
, cv, "Dumper.c", "v" "5" "." "32" "." "0", "2.174_01"); SV *
*mark = PL_stack_base + ax; SV **sp = PL_stack_sp; I32 items =
(I32)(sp - mark)
;
1940#endif
1941#if (PERL_REVISION5 == 5 && PERL_VERSION32 < 9)
1942 char* file = __FILE__"Dumper.c";
1943#else
1944 const char* file = __FILE__"Dumper.c";
1945#endif
1946
1947 PERL_UNUSED_VAR(file)((void)sizeof(file));
1948
1949 PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */
1950 PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */
1951#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
1952 XS_VERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter))
<< 16) | ((sizeof("" "2.174_01" "")-1) > 0xFF ? (Perl_croak
("panic: handshake overflow"), 0xFF) : (sizeof("" "2.174_01" ""
)-1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020
: 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((
((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" ""
"")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "" "")-1))), cv, "Dumper.c", items
, ax, "2.174_01")
;
1953# ifdef XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter))
<< 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak
("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) <<
8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((
0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool
)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32"
"." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1)))
, cv, "Dumper.c", items, ax, "v" "5" "." "32" "." "0")
1954 XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter))
<< 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak
("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) <<
8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((
0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool
)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32"
"." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1)))
, cv, "Dumper.c", items, ax, "v" "5" "." "32" "." "0")
;
1955# endif
1956#endif
1957
1958 (void)newXSproto_portable("Data::Dumper::Dumpxs", XS_Data__Dumper_Dumpxs, file, "$;$$")Perl_newXS_flags( "Data::Dumper::Dumpxs",XS_Data__Dumper_Dumpxs
,file,"$;$$",0)
;
1959 (void)newXSproto_portable("Data::Dumper::_vstring", XS_Data__Dumper__vstring, file, "$")Perl_newXS_flags( "Data::Dumper::_vstring",XS_Data__Dumper__vstring
,file,"$",0)
;
1960#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
1961# if PERL_VERSION_GE(5, 9, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 9*1000 + 0))
1962 if (PL_unitcheckav)
1963 call_list(PL_scopestack_ix, PL_unitcheckav)Perl_call_list( PL_scopestack_ix,PL_unitcheckav);
1964# endif
1965 XSRETURN_YESdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[0]) ); do
{ const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0)
;
1966#else
1967 Perl_xs_boot_epilog(aTHX_ ax);
1968#endif
1969}
1970