This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Added test for pack_addr_in and unpack_addr_in
[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
15print "1..17\n";
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);
36 } else {
37 die "$0: failed to open peek$$: !\n";
38 }
39 } else {
40 die "$0: failed to create peek$$: $!\n";
41 }
42}
43
44our $a;
45our $b;
46my $c;
208edb77 47local $d = 0;
9248c45a
JH
48
49do_test( 1,
50 $a = "foo",
51'SV = PV\\($ADDR\\) at $ADDR
52 REFCNT = 1
53 FLAGS = \\(POK,pPOK\\)
54 PV = $ADDR "foo"\\\0
55 CUR = 3
56 LEN = 4'
57 );
58
59do_test( 2,
60 "bar",
61'SV = PV\\($ADDR\\) at $ADDR
62 REFCNT = 1
7766e686 63 FLAGS = \\(.*POK,READONLY,pPOK\\)
9248c45a
JH
64 PV = $ADDR "bar"\\\0
65 CUR = 3
66 LEN = 4');
67
68do_test( 3,
69 $b = 123,
70'SV = IV\\($ADDR\\) at $ADDR
71 REFCNT = 1
72 FLAGS = \\(IOK,pIOK\\)
73 IV = 123');
74
75do_test( 4,
76 456,
77'SV = IV\\($ADDR\\) at $ADDR
78 REFCNT = 1
7766e686 79 FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a
JH
80 IV = 456');
81
82do_test( 5,
83 $c = 456,
84'SV = IV\\($ADDR\\) at $ADDR
85 REFCNT = 1
86 FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
87 IV = 456');
88
89do_test( 6,
90 $c + $d,
28e5dec8 91'SV = IV\\($ADDR\\) at $ADDR
9248c45a 92 REFCNT = 1
28e5dec8
JH
93 FLAGS = \\(PADTMP,IOK,pIOK\\)
94 IV = 456');
9248c45a
JH
95
96($d = "789") += 0.1;
97
98do_test( 7,
99 $d,
100'SV = PVNV\\($ADDR\\) at $ADDR
101 REFCNT = 1
102 FLAGS = \\(NOK,pNOK\\)
103 IV = 0
ac634a9a 104 NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
9248c45a
JH
105 PV = $ADDR "789"\\\0
106 CUR = 3
107 LEN = 4');
108
109do_test( 8,
110 0xabcd,
111'SV = IV\\($ADDR\\) at $ADDR
112 REFCNT = 1
28e5dec8
JH
113 FLAGS = \\(.*IOK,READONLY,pIOK\\)
114 IV = 43981');
9248c45a
JH
115
116do_test( 9,
117 undef,
118'SV = NULL\\(0x0\\) at $ADDR
119 REFCNT = 1
120 FLAGS = \\(\\)');
121
122do_test(10,
123 \$a,
124'SV = RV\\($ADDR\\) at $ADDR
125 REFCNT = 1
126 FLAGS = \\(ROK\\)
127 RV = $ADDR
128 SV = PV\\($ADDR\\) at $ADDR
129 REFCNT = 2
130 FLAGS = \\(POK,pPOK\\)
131 PV = $ADDR "foo"\\\0
132 CUR = 3
133 LEN = 4');
134
135do_test(11,
136 [$b,$c],
137'SV = RV\\($ADDR\\) at $ADDR
138 REFCNT = 1
139 FLAGS = \\(ROK\\)
140 RV = $ADDR
141 SV = PVAV\\($ADDR\\) at $ADDR
142 REFCNT = 2
143 FLAGS = \\(\\)
144 IV = 0
145 NV = 0
146 ARRAY = $ADDR
147 FILL = 1
148 MAX = 1
149 ARYLEN = 0x0
150 FLAGS = \\(REAL\\)
151 Elt No. 0
152 SV = IV\\($ADDR\\) at $ADDR
153 REFCNT = 1
154 FLAGS = \\(IOK,pIOK\\)
155 IV = 123
156 Elt No. 1
28e5dec8 157 SV = IV\\($ADDR\\) at $ADDR
9248c45a 158 REFCNT = 1
28e5dec8
JH
159 FLAGS = \\(IOK,pIOK\\)
160 IV = 456');
9248c45a
JH
161
162do_test(12,
163 {$b=>$c},
164'SV = RV\\($ADDR\\) at $ADDR
165 REFCNT = 1
166 FLAGS = \\(ROK\\)
167 RV = $ADDR
168 SV = PVHV\\($ADDR\\) at $ADDR
169 REFCNT = 2
170 FLAGS = \\(SHAREKEYS\\)
171 IV = 1
172 NV = 0
173 ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8 174 hash quality = 100.0%
9248c45a
JH
175 KEYS = 1
176 FILL = 1
177 MAX = 7
178 RITER = -1
179 EITER = 0x0
180 Elt "123" HASH = $ADDR
28e5dec8 181 SV = IV\\($ADDR\\) at $ADDR
9248c45a 182 REFCNT = 1
28e5dec8
JH
183 FLAGS = \\(IOK,pIOK\\)
184 IV = 456');
9248c45a
JH
185
186do_test(13,
187 sub(){@_},
188'SV = RV\\($ADDR\\) at $ADDR
189 REFCNT = 1
190 FLAGS = \\(ROK\\)
191 RV = $ADDR
192 SV = PVCV\\($ADDR\\) at $ADDR
193 REFCNT = 2
194 FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
195 IV = 0
196 NV = 0
197 PROTOTYPE = ""
198 COMP_STASH = $ADDR\\t"main"
199 START = $ADDR ===> \\d+
200 ROOT = $ADDR
201 XSUB = 0x0
202 XSUBANY = 0
208edb77 203 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
084d946d 204 FILE = ".*\\b(?i:peek\\.t)"
9248c45a 205 DEPTH = 0
9856a127 206(?: MUTEXP = $ADDR
208edb77
MG
207 OWNER = $ADDR
208)? FLAGS = 0x4
9248c45a
JH
209 PADLIST = $ADDR
210 OUTSIDE = $ADDR \\(MAIN\\)');
211
212do_test(14,
213 \&do_test,
214'SV = RV\\($ADDR\\) at $ADDR
215 REFCNT = 1
216 FLAGS = \\(ROK\\)
217 RV = $ADDR
218 SV = PVCV\\($ADDR\\) at $ADDR
9856a127 219 REFCNT = (3|4)
9248c45a
JH
220 FLAGS = \\(\\)
221 IV = 0
222 NV = 0
223 COMP_STASH = $ADDR\\t"main"
224 START = $ADDR ===> \\d+
225 ROOT = $ADDR
226 XSUB = 0x0
227 XSUBANY = 0
228 GVGV::GV = $ADDR\\t"main" :: "do_test"
084d946d 229 FILE = ".*\\b(?i:peek\\.t)"
9248c45a 230 DEPTH = 1
9856a127 231(?: MUTEXP = $ADDR
208edb77
MG
232 OWNER = $ADDR
233)? FLAGS = 0x0
9248c45a 234 PADLIST = $ADDR
7766e686
GS
235 \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
236 \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
237 \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
9248c45a
JH
238 OUTSIDE = $ADDR \\(MAIN\\)');
239
240do_test(15,
241 qr(tic),
242'SV = RV\\($ADDR\\) at $ADDR
243 REFCNT = 1
244 FLAGS = \\(ROK\\)
245 RV = $ADDR
246 SV = PVMG\\($ADDR\\) at $ADDR
247 REFCNT = 1
248 FLAGS = \\(OBJECT,RMG\\)
249 IV = 0
250 NV = 0
251 PV = 0
252 MAGIC = $ADDR
253 MG_VIRTUAL = $ADDR
14befaf4 254 MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a
JH
255 MG_OBJ = $ADDR
256 STASH = $ADDR\\t"Regexp"');
257
258do_test(16,
259 (bless {}, "Tac"),
260'SV = RV\\($ADDR\\) at $ADDR
261 REFCNT = 1
262 FLAGS = \\(ROK\\)
263 RV = $ADDR
264 SV = PVHV\\($ADDR\\) at $ADDR
265 REFCNT = 2
266 FLAGS = \\(OBJECT,SHAREKEYS\\)
267 IV = 0
268 NV = 0
269 STASH = $ADDR\\t"Tac"
270 ARRAY = 0x0
271 KEYS = 0
272 FILL = 0
273 MAX = 7
274 RITER = -1
275 EITER = 0x0');
276
277do_test(17,
278 *a,
279'SV = PVGV\\($ADDR\\) at $ADDR
280 REFCNT = 5
b07ccbd7 281 FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
9248c45a
JH
282 IV = 0
283 NV = 0
284 MAGIC = $ADDR
285 MG_VIRTUAL = &PL_vtbl_glob
14befaf4 286 MG_TYPE = PERL_MAGIC_glob\(\*\)
9248c45a 287 MG_OBJ = $ADDR
9248c45a
JH
288 NAME = "a"
289 NAMELEN = 1
290 GvSTASH = $ADDR\\t"main"
291 GP = $ADDR
292 SV = $ADDR
293 REFCNT = 1
294 IO = 0x0
295 FORM = 0x0
296 AV = 0x0
297 HV = 0x0
298 CV = 0x0
299 CVGEN = 0x0
300 GPFLAGS = 0x0
9ec58fb7 301 LINE = \\d+
084d946d 302 FILE = ".*\\b(?i:peek\\.t)"
e39917cc 303 FLAGS = $ADDR
9248c45a
JH
304 EGV = $ADDR\\t"a"');
305
306END {
92e5451f 307 1 while unlink("peek$$");
9248c45a 308}