This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate changes #12241 and #12242 from macperl:
[perl5.git] / ext / Devel / Peek / Peek.t
CommitLineData
9ec58fb7
JH
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
9ec58fb7
JH
6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bPeek\b/) {
8 print "1..0 # Skip: Devel::Peek was not built\n";
9 exit 0;
10 }
11}
12
9248c45a
JH
13use Devel::Peek;
14
e6abe6d8 15print "1..18\n";
9248c45a
JH
16
17our $DEBUG = 0;
277ddfaf 18open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
9248c45a
JH
19
20sub do_test {
21 my $pattern = pop;
277ddfaf
GS
22 if (open(OUT,">peek$$")) {
23 open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
9248c45a 24 Dump($_[1]);
277ddfaf
GS
25 open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
26 close(OUT);
9248c45a
JH
27 if (open(IN, "peek$$")) {
28 local $/;
29 $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
30 print $pattern, "\n" if $DEBUG;
31 my $dump = <IN>;
32 print $dump, "\n" if $DEBUG;
9856a127 33 print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
9248c45a
JH
34 print "ok $_[0]\n";
35 close(IN);
59d8ce62 36 return $1;
9248c45a
JH
37 } else {
38 die "$0: failed to open peek$$: !\n";
39 }
40 } else {
41 die "$0: failed to create peek$$: $!\n";
42 }
43}
44
45our $a;
46our $b;
47my $c;
208edb77 48local $d = 0;
9248c45a
JH
49
50do_test( 1,
51 $a = "foo",
52'SV = PV\\($ADDR\\) at $ADDR
53 REFCNT = 1
54 FLAGS = \\(POK,pPOK\\)
55 PV = $ADDR "foo"\\\0
56 CUR = 3
57 LEN = 4'
58 );
59
60do_test( 2,
61 "bar",
62'SV = PV\\($ADDR\\) at $ADDR
63 REFCNT = 1
7766e686 64 FLAGS = \\(.*POK,READONLY,pPOK\\)
9248c45a
JH
65 PV = $ADDR "bar"\\\0
66 CUR = 3
67 LEN = 4');
68
69do_test( 3,
70 $b = 123,
71'SV = IV\\($ADDR\\) at $ADDR
72 REFCNT = 1
73 FLAGS = \\(IOK,pIOK\\)
74 IV = 123');
75
76do_test( 4,
77 456,
78'SV = IV\\($ADDR\\) at $ADDR
79 REFCNT = 1
7766e686 80 FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a
JH
81 IV = 456');
82
83do_test( 5,
84 $c = 456,
85'SV = IV\\($ADDR\\) at $ADDR
86 REFCNT = 1
87 FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
88 IV = 456');
89
59d8ce62
NC
90# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
91# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
92# maths is done in floating point always, and this scalar will be an NV.
93# ([NI]) captures the type, referred to by \1 in this regexp and $type for
94# building subsequent regexps.
95my $type = do_test( 6,
9248c45a 96 $c + $d,
59d8ce62 97'SV = ([NI])V\\($ADDR\\) at $ADDR
9248c45a 98 REFCNT = 1
59d8ce62
NC
99 FLAGS = \\(PADTMP,\1OK,p\1OK\\)
100 \1V = 456');
9248c45a
JH
101
102($d = "789") += 0.1;
103
104do_test( 7,
105 $d,
106'SV = PVNV\\($ADDR\\) at $ADDR
107 REFCNT = 1
108 FLAGS = \\(NOK,pNOK\\)
109 IV = 0
ac634a9a 110 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
9248c45a
JH
111 PV = $ADDR "789"\\\0
112 CUR = 3
113 LEN = 4');
114
115do_test( 8,
116 0xabcd,
117'SV = IV\\($ADDR\\) at $ADDR
118 REFCNT = 1
28e5dec8
JH
119 FLAGS = \\(.*IOK,READONLY,pIOK\\)
120 IV = 43981');
9248c45a
JH
121
122do_test( 9,
123 undef,
124'SV = NULL\\(0x0\\) at $ADDR
125 REFCNT = 1
126 FLAGS = \\(\\)');
127
128do_test(10,
129 \$a,
130'SV = RV\\($ADDR\\) at $ADDR
131 REFCNT = 1
132 FLAGS = \\(ROK\\)
133 RV = $ADDR
134 SV = PV\\($ADDR\\) at $ADDR
135 REFCNT = 2
136 FLAGS = \\(POK,pPOK\\)
137 PV = $ADDR "foo"\\\0
138 CUR = 3
139 LEN = 4');
140
59d8ce62
NC
141my $c_pattern;
142if ($type eq 'N') {
143 $c_pattern = '
144 SV = PVNV\\($ADDR\\) at $ADDR
145 REFCNT = 1
146 FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
147 IV = 456
148 NV = 456
149 PV = 0';
150} else {
151 $c_pattern = '
152 SV = IV\\($ADDR\\) at $ADDR
153 REFCNT = 1
154 FLAGS = \\(IOK,pIOK\\)
155 IV = 456';
156}
9248c45a
JH
157do_test(11,
158 [$b,$c],
159'SV = RV\\($ADDR\\) at $ADDR
160 REFCNT = 1
161 FLAGS = \\(ROK\\)
162 RV = $ADDR
163 SV = PVAV\\($ADDR\\) at $ADDR
164 REFCNT = 2
165 FLAGS = \\(\\)
166 IV = 0
167 NV = 0
168 ARRAY = $ADDR
169 FILL = 1
170 MAX = 1
171 ARYLEN = 0x0
172 FLAGS = \\(REAL\\)
173 Elt No. 0
174 SV = IV\\($ADDR\\) at $ADDR
175 REFCNT = 1
176 FLAGS = \\(IOK,pIOK\\)
177 IV = 123
59d8ce62 178 Elt No. 1' . $c_pattern);
9248c45a
JH
179
180do_test(12,
181 {$b=>$c},
182'SV = RV\\($ADDR\\) at $ADDR
183 REFCNT = 1
184 FLAGS = \\(ROK\\)
185 RV = $ADDR
186 SV = PVHV\\($ADDR\\) at $ADDR
187 REFCNT = 2
188 FLAGS = \\(SHAREKEYS\\)
189 IV = 1
190 NV = 0
191 ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8 192 hash quality = 100.0%
9248c45a
JH
193 KEYS = 1
194 FILL = 1
195 MAX = 7
196 RITER = -1
197 EITER = 0x0
59d8ce62 198 Elt "123" HASH = $ADDR' . $c_pattern);
9248c45a
JH
199
200do_test(13,
201 sub(){@_},
202'SV = RV\\($ADDR\\) at $ADDR
203 REFCNT = 1
204 FLAGS = \\(ROK\\)
205 RV = $ADDR
206 SV = PVCV\\($ADDR\\) at $ADDR
207 REFCNT = 2
208 FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
209 IV = 0
210 NV = 0
211 PROTOTYPE = ""
212 COMP_STASH = $ADDR\\t"main"
213 START = $ADDR ===> \\d+
214 ROOT = $ADDR
215 XSUB = 0x0
216 XSUBANY = 0
208edb77 217 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
084d946d 218 FILE = ".*\\b(?i:peek\\.t)"
9248c45a 219 DEPTH = 0
9856a127 220(?: MUTEXP = $ADDR
208edb77
MG
221 OWNER = $ADDR
222)? FLAGS = 0x4
9248c45a
JH
223 PADLIST = $ADDR
224 OUTSIDE = $ADDR \\(MAIN\\)');
225
226do_test(14,
227 \&do_test,
228'SV = RV\\($ADDR\\) at $ADDR
229 REFCNT = 1
230 FLAGS = \\(ROK\\)
231 RV = $ADDR
232 SV = PVCV\\($ADDR\\) at $ADDR
9856a127 233 REFCNT = (3|4)
9248c45a
JH
234 FLAGS = \\(\\)
235 IV = 0
236 NV = 0
237 COMP_STASH = $ADDR\\t"main"
238 START = $ADDR ===> \\d+
239 ROOT = $ADDR
240 XSUB = 0x0
241 XSUBANY = 0
242 GVGV::GV = $ADDR\\t"main" :: "do_test"
084d946d 243 FILE = ".*\\b(?i:peek\\.t)"
9248c45a 244 DEPTH = 1
9856a127 245(?: MUTEXP = $ADDR
208edb77
MG
246 OWNER = $ADDR
247)? FLAGS = 0x0
9248c45a 248 PADLIST = $ADDR
7766e686
GS
249 \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
250 \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
251 \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
9248c45a
JH
252 OUTSIDE = $ADDR \\(MAIN\\)');
253
254do_test(15,
255 qr(tic),
256'SV = RV\\($ADDR\\) at $ADDR
257 REFCNT = 1
258 FLAGS = \\(ROK\\)
259 RV = $ADDR
260 SV = PVMG\\($ADDR\\) at $ADDR
261 REFCNT = 1
262 FLAGS = \\(OBJECT,RMG\\)
263 IV = 0
264 NV = 0
265 PV = 0
266 MAGIC = $ADDR
267 MG_VIRTUAL = $ADDR
14befaf4 268 MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a
JH
269 MG_OBJ = $ADDR
270 STASH = $ADDR\\t"Regexp"');
271
272do_test(16,
273 (bless {}, "Tac"),
274'SV = RV\\($ADDR\\) at $ADDR
275 REFCNT = 1
276 FLAGS = \\(ROK\\)
277 RV = $ADDR
278 SV = PVHV\\($ADDR\\) at $ADDR
279 REFCNT = 2
280 FLAGS = \\(OBJECT,SHAREKEYS\\)
281 IV = 0
282 NV = 0
283 STASH = $ADDR\\t"Tac"
284 ARRAY = 0x0
285 KEYS = 0
286 FILL = 0
287 MAX = 7
288 RITER = -1
289 EITER = 0x0');
290
291do_test(17,
292 *a,
293'SV = PVGV\\($ADDR\\) at $ADDR
294 REFCNT = 5
b07ccbd7 295 FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
9248c45a
JH
296 IV = 0
297 NV = 0
298 MAGIC = $ADDR
299 MG_VIRTUAL = &PL_vtbl_glob
14befaf4 300 MG_TYPE = PERL_MAGIC_glob\(\*\)
9248c45a 301 MG_OBJ = $ADDR
9248c45a
JH
302 NAME = "a"
303 NAMELEN = 1
304 GvSTASH = $ADDR\\t"main"
305 GP = $ADDR
306 SV = $ADDR
307 REFCNT = 1
308 IO = 0x0
309 FORM = 0x0
310 AV = 0x0
311 HV = 0x0
312 CV = 0x0
313 CVGEN = 0x0
314 GPFLAGS = 0x0
9ec58fb7 315 LINE = \\d+
084d946d 316 FILE = ".*\\b(?i:peek\\.t)"
e39917cc 317 FLAGS = $ADDR
9248c45a
JH
318 EGV = $ADDR\\t"a"');
319
e6abe6d8
JH
320do_test(18,
321 chr(256).chr(0).chr(512),
322'SV = PV\\($ADDR\\) at $ADDR
323 REFCNT = 1
324 FLAGS = \\(PADBUSY,PADTMP,POK,READONLY,pPOK,UTF8\\)
325 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"
326 CUR = 5
327 LEN = 6');
328
9248c45a 329END {
92e5451f 330 1 while unlink("peek$$");
9248c45a 331}