1b39c5158Smillert#!./perl -w
2b39c5158Smillert#
3b39c5158Smillert# testsuite for Data::Dumper
4b39c5158Smillert#
5b39c5158Smillert
6b39c5158SmillertBEGIN {
7b39c5158Smillert    require Config; import Config;
8b39c5158Smillert    if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
9b39c5158Smillert	print "1..0 # Skip: Data::Dumper was not built\n";
10b39c5158Smillert	exit 0;
11b39c5158Smillert    }
12b39c5158Smillert}
13b39c5158Smillert
14b39c5158Smillert# Since Perl 5.8.1 because otherwise hash ordering is really random.
15b39c5158Smillertlocal $Data::Dumper::Sortkeys = 1;
16b39c5158Smillert
17b39c5158Smillertuse Data::Dumper;
18b39c5158Smillertuse Config;
19b39c5158Smillertmy $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
20b39c5158Smillert
21b39c5158Smillert$Data::Dumper::Pad = "#";
22b39c5158Smillertmy $TMAX;
23b39c5158Smillertmy $XS;
24b39c5158Smillertmy $TNUM = 0;
25b39c5158Smillertmy $WANT = '';
26b39c5158Smillert
27b39c5158Smillertsub TEST {
28b39c5158Smillert  my $string = shift;
29b39c5158Smillert  my $name = shift;
30b39c5158Smillert  my $t = eval $string;
31b39c5158Smillert  ++$TNUM;
32b39c5158Smillert  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
33b39c5158Smillert      if ($WANT =~ /deadbeef/);
34b39c5158Smillert  if ($Is_ebcdic) {
35b39c5158Smillert      # these data need massaging with non ascii character sets
36b39c5158Smillert      # because of hashing order differences
37b39c5158Smillert      $WANT = join("\n",sort(split(/\n/,$WANT)));
38b39c5158Smillert      $WANT =~ s/\,$//mg;
39b39c5158Smillert      $t    = join("\n",sort(split(/\n/,$t)));
40b39c5158Smillert      $t    =~ s/\,$//mg;
41b39c5158Smillert  }
42b39c5158Smillert  $name = $name ? " - $name" : '';
43b39c5158Smillert  print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n"
44b39c5158Smillert	: "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n");
45b39c5158Smillert
46b39c5158Smillert  ++$TNUM;
47b39c5158Smillert  if ($Is_ebcdic) { # EBCDIC.
48b39c5158Smillert      if ($TNUM == 311 || $TNUM == 314) {
49b39c5158Smillert	  eval $string;
50b39c5158Smillert      } else {
51b39c5158Smillert	  eval $t;
52b39c5158Smillert      }
53b39c5158Smillert  } else {
54b39c5158Smillert      eval "$t";
55b39c5158Smillert  }
56b39c5158Smillert  print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
57b39c5158Smillert
58b39c5158Smillert  $t = eval $string;
59b39c5158Smillert  ++$TNUM;
60b39c5158Smillert  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
61b39c5158Smillert      if ($WANT =~ /deadbeef/);
62b39c5158Smillert  if ($Is_ebcdic) {
63b39c5158Smillert      # here too there are hashing order differences
64b39c5158Smillert      $WANT = join("\n",sort(split(/\n/,$WANT)));
65b39c5158Smillert      $WANT =~ s/\,$//mg;
66b39c5158Smillert      $t    = join("\n",sort(split(/\n/,$t)));
67b39c5158Smillert      $t    =~ s/\,$//mg;
68b39c5158Smillert  }
69b39c5158Smillert  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
70b39c5158Smillert	: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
71b39c5158Smillert}
72b39c5158Smillert
73b39c5158Smillertsub SKIP_TEST {
74b39c5158Smillert  my $reason = shift;
75b39c5158Smillert  ++$TNUM; print "ok $TNUM # skip $reason\n";
76b39c5158Smillert  ++$TNUM; print "ok $TNUM # skip $reason\n";
77b39c5158Smillert  ++$TNUM; print "ok $TNUM # skip $reason\n";
78b39c5158Smillert}
79b39c5158Smillert
80b39c5158Smillert# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
81b39c5158Smillert# it direct. Out here it lets us knobble the next if to test that the perl
82b39c5158Smillert# only tests do work (and count correctly)
83b39c5158Smillert$Data::Dumper::Useperl = 1;
84b39c5158Smillertif (defined &Data::Dumper::Dumpxs) {
85b39c5158Smillert  print "### XS extension loaded, will run XS tests\n";
86*91f110e0Safresh1  $TMAX = 402; $XS = 1;
87b39c5158Smillert}
88b39c5158Smillertelse {
89b39c5158Smillert  print "### XS extensions not loaded, will NOT run XS tests\n";
90*91f110e0Safresh1  $TMAX = 201; $XS = 0;
91b39c5158Smillert}
92b39c5158Smillert
93b39c5158Smillertprint "1..$TMAX\n";
94b39c5158Smillert
95b39c5158Smillert#XXXif (0) {
96b39c5158Smillert#############
97b39c5158Smillert#############
98b39c5158Smillert
99b39c5158Smillert@c = ('c');
100b39c5158Smillert$c = \@c;
101b39c5158Smillert$b = {};
102b39c5158Smillert$a = [1, $b, $c];
103b39c5158Smillert$b->{a} = $a;
104b39c5158Smillert$b->{b} = $a->[1];
105b39c5158Smillert$b->{c} = $a->[2];
106b39c5158Smillert
107b39c5158Smillert############# 1
108b39c5158Smillert##
109b39c5158Smillert$WANT = <<'EOT';
110b39c5158Smillert#$a = [
111b39c5158Smillert#       1,
112b39c5158Smillert#       {
113b39c5158Smillert#         'a' => $a,
114b39c5158Smillert#         'b' => $a->[1],
115b39c5158Smillert#         'c' => [
116b39c5158Smillert#                  'c'
117b39c5158Smillert#                ]
118b39c5158Smillert#       },
119b39c5158Smillert#       $a->[1]{'c'}
120b39c5158Smillert#     ];
121b39c5158Smillert#$b = $a->[1];
122b39c5158Smillert#$6 = $a->[1]{'c'};
123b39c5158SmillertEOT
124b39c5158Smillert
125b39c5158SmillertTEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6]));
126b39c5158SmillertTEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS;
127b39c5158Smillert
128*91f110e0Safresh1SCOPE: {
129*91f110e0Safresh1  local $Data::Dumper::Sparseseen = 1;
130*91f110e0Safresh1  TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6]));
131*91f110e0Safresh1  TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS;
132*91f110e0Safresh1}
133b39c5158Smillert
134b39c5158Smillert############# 7
135b39c5158Smillert##
136b39c5158Smillert$WANT = <<'EOT';
137b39c5158Smillert#@a = (
138b39c5158Smillert#       1,
139b39c5158Smillert#       {
140b39c5158Smillert#         'a' => [],
141b39c5158Smillert#         'b' => {},
142b39c5158Smillert#         'c' => [
143b39c5158Smillert#                  'c'
144b39c5158Smillert#                ]
145b39c5158Smillert#       },
146b39c5158Smillert#       []
147b39c5158Smillert#     );
148b39c5158Smillert#$a[1]{'a'} = \@a;
149b39c5158Smillert#$a[1]{'b'} = $a[1];
150b39c5158Smillert#$a[2] = $a[1]{'c'};
151b39c5158Smillert#$b = $a[1];
152b39c5158SmillertEOT
153b39c5158Smillert
154b39c5158Smillert$Data::Dumper::Purity = 1;         # fill in the holes for eval
155b39c5158SmillertTEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
156b39c5158SmillertTEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
157b39c5158Smillert
158*91f110e0Safresh1SCOPE: {
159*91f110e0Safresh1  local $Data::Dumper::Sparseseen = 1;
160*91f110e0Safresh1  TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
161*91f110e0Safresh1  TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
162*91f110e0Safresh1}
163*91f110e0Safresh1
164b39c5158Smillert############# 13
165b39c5158Smillert##
166b39c5158Smillert$WANT = <<'EOT';
167b39c5158Smillert#%b = (
168b39c5158Smillert#       'a' => [
169b39c5158Smillert#                1,
170b39c5158Smillert#                {},
171b39c5158Smillert#                [
172b39c5158Smillert#                  'c'
173b39c5158Smillert#                ]
174b39c5158Smillert#              ],
175b39c5158Smillert#       'b' => {},
176b39c5158Smillert#       'c' => []
177b39c5158Smillert#     );
178b39c5158Smillert#$b{'a'}[1] = \%b;
179b39c5158Smillert#$b{'b'} = \%b;
180b39c5158Smillert#$b{'c'} = $b{'a'}[2];
181b39c5158Smillert#$a = $b{'a'};
182b39c5158SmillertEOT
183b39c5158Smillert
184b39c5158SmillertTEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
185b39c5158SmillertTEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
186b39c5158Smillert
187b39c5158Smillert############# 19
188b39c5158Smillert##
189b39c5158Smillert$WANT = <<'EOT';
190b39c5158Smillert#$a = [
191b39c5158Smillert#  1,
192b39c5158Smillert#  {
193b39c5158Smillert#    'a' => [],
194b39c5158Smillert#    'b' => {},
195b39c5158Smillert#    'c' => []
196b39c5158Smillert#  },
197b39c5158Smillert#  []
198b39c5158Smillert#];
199b39c5158Smillert#$a->[1]{'a'} = $a;
200b39c5158Smillert#$a->[1]{'b'} = $a->[1];
201b39c5158Smillert#$a->[1]{'c'} = \@c;
202b39c5158Smillert#$a->[2] = \@c;
203b39c5158Smillert#$b = $a->[1];
204b39c5158SmillertEOT
205b39c5158Smillert
206b39c5158Smillert$Data::Dumper::Indent = 1;
207b39c5158SmillertTEST q(
208b39c5158Smillert       $d = Data::Dumper->new([$a,$b], [qw(a b)]);
209b39c5158Smillert       $d->Seen({'*c' => $c});
210b39c5158Smillert       $d->Dump;
211b39c5158Smillert      );
212b39c5158Smillertif ($XS) {
213b39c5158Smillert  TEST q(
214b39c5158Smillert	 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
215b39c5158Smillert	 $d->Seen({'*c' => $c});
216b39c5158Smillert	 $d->Dumpxs;
217b39c5158Smillert	);
218b39c5158Smillert}
219b39c5158Smillert
220b39c5158Smillert
221b39c5158Smillert############# 25
222b39c5158Smillert##
223b39c5158Smillert$WANT = <<'EOT';
224b39c5158Smillert#$a = [
225b39c5158Smillert#       #0
226b39c5158Smillert#       1,
227b39c5158Smillert#       #1
228b39c5158Smillert#       {
229b39c5158Smillert#         a => $a,
230b39c5158Smillert#         b => $a->[1],
231b39c5158Smillert#         c => [
232b39c5158Smillert#                #0
233b39c5158Smillert#                'c'
234b39c5158Smillert#              ]
235b39c5158Smillert#       },
236b39c5158Smillert#       #2
237b39c5158Smillert#       $a->[1]{c}
238b39c5158Smillert#     ];
239b39c5158Smillert#$b = $a->[1];
240b39c5158SmillertEOT
241b39c5158Smillert
242b39c5158Smillert$d->Indent(3);
243b39c5158Smillert$d->Purity(0)->Quotekeys(0);
244b39c5158SmillertTEST q( $d->Reset; $d->Dump );
245b39c5158Smillert
246b39c5158SmillertTEST q( $d->Reset; $d->Dumpxs ) if $XS;
247b39c5158Smillert
248b39c5158Smillert############# 31
249b39c5158Smillert##
250b39c5158Smillert$WANT = <<'EOT';
251b39c5158Smillert#$VAR1 = [
252b39c5158Smillert#  1,
253b39c5158Smillert#  {
254b39c5158Smillert#    'a' => [],
255b39c5158Smillert#    'b' => {},
256b39c5158Smillert#    'c' => [
257b39c5158Smillert#      'c'
258b39c5158Smillert#    ]
259b39c5158Smillert#  },
260b39c5158Smillert#  []
261b39c5158Smillert#];
262b39c5158Smillert#$VAR1->[1]{'a'} = $VAR1;
263b39c5158Smillert#$VAR1->[1]{'b'} = $VAR1->[1];
264b39c5158Smillert#$VAR1->[2] = $VAR1->[1]{'c'};
265b39c5158SmillertEOT
266b39c5158Smillert
267b39c5158SmillertTEST q(Dumper($a));
268b39c5158SmillertTEST q(Data::Dumper::DumperX($a)) if $XS;
269b39c5158Smillert
270b39c5158Smillert############# 37
271b39c5158Smillert##
272b39c5158Smillert$WANT = <<'EOT';
273b39c5158Smillert#[
274b39c5158Smillert#  1,
275b39c5158Smillert#  {
276b39c5158Smillert#    a => $VAR1,
277b39c5158Smillert#    b => $VAR1->[1],
278b39c5158Smillert#    c => [
279b39c5158Smillert#      'c'
280b39c5158Smillert#    ]
281b39c5158Smillert#  },
282b39c5158Smillert#  $VAR1->[1]{c}
283b39c5158Smillert#]
284b39c5158SmillertEOT
285b39c5158Smillert
286b39c5158Smillert{
287b39c5158Smillert  local $Data::Dumper::Purity = 0;
288b39c5158Smillert  local $Data::Dumper::Quotekeys = 0;
289b39c5158Smillert  local $Data::Dumper::Terse = 1;
290b39c5158Smillert  TEST q(Dumper($a));
291b39c5158Smillert  TEST q(Data::Dumper::DumperX($a)) if $XS;
292b39c5158Smillert}
293b39c5158Smillert
294b39c5158Smillert
295b39c5158Smillert############# 43
296b39c5158Smillert##
297b39c5158Smillert$WANT = <<'EOT';
298b39c5158Smillert#$VAR1 = {
299b39c5158Smillert#  "abc\0'\efg" => "mno\0",
300b39c5158Smillert#  "reftest" => \\1
301b39c5158Smillert#};
302b39c5158SmillertEOT
303b39c5158Smillert
304b39c5158Smillert$foo = { "abc\000\'\efg" => "mno\000",
305b39c5158Smillert         "reftest" => \\1,
306b39c5158Smillert       };
307b39c5158Smillert{
308b39c5158Smillert  local $Data::Dumper::Useqq = 1;
309b39c5158Smillert  TEST q(Dumper($foo));
310b39c5158Smillert}
311b39c5158Smillert
312b39c5158Smillert  $WANT = <<"EOT";
313b39c5158Smillert#\$VAR1 = {
314b39c5158Smillert#  'abc\0\\'\efg' => 'mno\0',
315b39c5158Smillert#  'reftest' => \\\\1
316b39c5158Smillert#};
317b39c5158SmillertEOT
318b39c5158Smillert
319b39c5158Smillert  {
320b39c5158Smillert    local $Data::Dumper::Useqq = 1;
321b39c5158Smillert    TEST q(Data::Dumper::DumperX($foo)) if $XS;   # cheat
322b39c5158Smillert  }
323b39c5158Smillert
324b39c5158Smillert
325b39c5158Smillert
326b39c5158Smillert#############
327b39c5158Smillert#############
328b39c5158Smillert
329b39c5158Smillert{
330b39c5158Smillert  package main;
331b39c5158Smillert  use Data::Dumper;
332b39c5158Smillert  $foo = 5;
333b39c5158Smillert  @foo = (-10,\*foo);
334b39c5158Smillert  %foo = (a=>1,b=>\$foo,c=>\@foo);
335b39c5158Smillert  $foo{d} = \%foo;
336b39c5158Smillert  $foo[2] = \%foo;
337b39c5158Smillert
338b39c5158Smillert############# 49
339b39c5158Smillert##
340b39c5158Smillert  $WANT = <<'EOT';
341b39c5158Smillert#$foo = \*::foo;
342b39c5158Smillert#*::foo = \5;
343b39c5158Smillert#*::foo = [
344b39c5158Smillert#           #0
345b39c5158Smillert#           -10,
346b39c5158Smillert#           #1
347b39c5158Smillert#           do{my $o},
348b39c5158Smillert#           #2
349b39c5158Smillert#           {
350b39c5158Smillert#             'a' => 1,
351b39c5158Smillert#             'b' => do{my $o},
352b39c5158Smillert#             'c' => [],
353b39c5158Smillert#             'd' => {}
354b39c5158Smillert#           }
355b39c5158Smillert#         ];
356b39c5158Smillert#*::foo{ARRAY}->[1] = $foo;
357b39c5158Smillert#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
358b39c5158Smillert#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
359b39c5158Smillert#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
360b39c5158Smillert#*::foo = *::foo{ARRAY}->[2];
361b39c5158Smillert#@bar = @{*::foo{ARRAY}};
362b39c5158Smillert#%baz = %{*::foo{ARRAY}->[2]};
363b39c5158SmillertEOT
364b39c5158Smillert
365b39c5158Smillert  $Data::Dumper::Purity = 1;
366b39c5158Smillert  $Data::Dumper::Indent = 3;
367b39c5158Smillert  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
368b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
369b39c5158Smillert
370b39c5158Smillert############# 55
371b39c5158Smillert##
372b39c5158Smillert  $WANT = <<'EOT';
373b39c5158Smillert#$foo = \*::foo;
374b39c5158Smillert#*::foo = \5;
375b39c5158Smillert#*::foo = [
376b39c5158Smillert#  -10,
377b39c5158Smillert#  do{my $o},
378b39c5158Smillert#  {
379b39c5158Smillert#    'a' => 1,
380b39c5158Smillert#    'b' => do{my $o},
381b39c5158Smillert#    'c' => [],
382b39c5158Smillert#    'd' => {}
383b39c5158Smillert#  }
384b39c5158Smillert#];
385b39c5158Smillert#*::foo{ARRAY}->[1] = $foo;
386b39c5158Smillert#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
387b39c5158Smillert#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
388b39c5158Smillert#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
389b39c5158Smillert#*::foo = *::foo{ARRAY}->[2];
390b39c5158Smillert#$bar = *::foo{ARRAY};
391b39c5158Smillert#$baz = *::foo{ARRAY}->[2];
392b39c5158SmillertEOT
393b39c5158Smillert
394b39c5158Smillert  $Data::Dumper::Indent = 1;
395b39c5158Smillert  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
396b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
397b39c5158Smillert
398b39c5158Smillert############# 61
399b39c5158Smillert##
400b39c5158Smillert  $WANT = <<'EOT';
401b39c5158Smillert#@bar = (
402b39c5158Smillert#  -10,
403b39c5158Smillert#  \*::foo,
404b39c5158Smillert#  {}
405b39c5158Smillert#);
406b39c5158Smillert#*::foo = \5;
407b39c5158Smillert#*::foo = \@bar;
408b39c5158Smillert#*::foo = {
409b39c5158Smillert#  'a' => 1,
410b39c5158Smillert#  'b' => do{my $o},
411b39c5158Smillert#  'c' => [],
412b39c5158Smillert#  'd' => {}
413b39c5158Smillert#};
414b39c5158Smillert#*::foo{HASH}->{'b'} = *::foo{SCALAR};
415b39c5158Smillert#*::foo{HASH}->{'c'} = \@bar;
416b39c5158Smillert#*::foo{HASH}->{'d'} = *::foo{HASH};
417b39c5158Smillert#$bar[2] = *::foo{HASH};
418b39c5158Smillert#%baz = %{*::foo{HASH}};
419b39c5158Smillert#$foo = $bar[1];
420b39c5158SmillertEOT
421b39c5158Smillert
422b39c5158Smillert  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
423b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
424b39c5158Smillert
425b39c5158Smillert############# 67
426b39c5158Smillert##
427b39c5158Smillert  $WANT = <<'EOT';
428b39c5158Smillert#$bar = [
429b39c5158Smillert#  -10,
430b39c5158Smillert#  \*::foo,
431b39c5158Smillert#  {}
432b39c5158Smillert#];
433b39c5158Smillert#*::foo = \5;
434b39c5158Smillert#*::foo = $bar;
435b39c5158Smillert#*::foo = {
436b39c5158Smillert#  'a' => 1,
437b39c5158Smillert#  'b' => do{my $o},
438b39c5158Smillert#  'c' => [],
439b39c5158Smillert#  'd' => {}
440b39c5158Smillert#};
441b39c5158Smillert#*::foo{HASH}->{'b'} = *::foo{SCALAR};
442b39c5158Smillert#*::foo{HASH}->{'c'} = $bar;
443b39c5158Smillert#*::foo{HASH}->{'d'} = *::foo{HASH};
444b39c5158Smillert#$bar->[2] = *::foo{HASH};
445b39c5158Smillert#$baz = *::foo{HASH};
446b39c5158Smillert#$foo = $bar->[1];
447b39c5158SmillertEOT
448b39c5158Smillert
449b39c5158Smillert  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
450b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
451b39c5158Smillert
452b39c5158Smillert############# 73
453b39c5158Smillert##
454b39c5158Smillert  $WANT = <<'EOT';
455b39c5158Smillert#$foo = \*::foo;
456b39c5158Smillert#@bar = (
457b39c5158Smillert#  -10,
458b39c5158Smillert#  $foo,
459b39c5158Smillert#  {
460b39c5158Smillert#    a => 1,
461b39c5158Smillert#    b => \5,
462b39c5158Smillert#    c => \@bar,
463b39c5158Smillert#    d => $bar[2]
464b39c5158Smillert#  }
465b39c5158Smillert#);
466b39c5158Smillert#%baz = %{$bar[2]};
467b39c5158SmillertEOT
468b39c5158Smillert
469b39c5158Smillert  $Data::Dumper::Purity = 0;
470b39c5158Smillert  $Data::Dumper::Quotekeys = 0;
471b39c5158Smillert  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
472b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
473b39c5158Smillert
474b39c5158Smillert############# 79
475b39c5158Smillert##
476b39c5158Smillert  $WANT = <<'EOT';
477b39c5158Smillert#$foo = \*::foo;
478b39c5158Smillert#$bar = [
479b39c5158Smillert#  -10,
480b39c5158Smillert#  $foo,
481b39c5158Smillert#  {
482b39c5158Smillert#    a => 1,
483b39c5158Smillert#    b => \5,
484b39c5158Smillert#    c => $bar,
485b39c5158Smillert#    d => $bar->[2]
486b39c5158Smillert#  }
487b39c5158Smillert#];
488b39c5158Smillert#$baz = $bar->[2];
489b39c5158SmillertEOT
490b39c5158Smillert
491b39c5158Smillert  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
492b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
493b39c5158Smillert
494b39c5158Smillert}
495b39c5158Smillert
496b39c5158Smillert#############
497b39c5158Smillert#############
498b39c5158Smillert{
499b39c5158Smillert  package main;
500b39c5158Smillert  @dogs = ( 'Fido', 'Wags' );
501b39c5158Smillert  %kennel = (
502b39c5158Smillert            First => \$dogs[0],
503b39c5158Smillert            Second =>  \$dogs[1],
504b39c5158Smillert           );
505b39c5158Smillert  $dogs[2] = \%kennel;
506b39c5158Smillert  $mutts = \%kennel;
507b39c5158Smillert  $mutts = $mutts;         # avoid warning
508b39c5158Smillert
509b39c5158Smillert############# 85
510b39c5158Smillert##
511b39c5158Smillert  $WANT = <<'EOT';
512b39c5158Smillert#%kennels = (
513b39c5158Smillert#  First => \'Fido',
514b39c5158Smillert#  Second => \'Wags'
515b39c5158Smillert#);
516b39c5158Smillert#@dogs = (
517b39c5158Smillert#  ${$kennels{First}},
518b39c5158Smillert#  ${$kennels{Second}},
519b39c5158Smillert#  \%kennels
520b39c5158Smillert#);
521b39c5158Smillert#%mutts = %kennels;
522b39c5158SmillertEOT
523b39c5158Smillert
524b39c5158Smillert  TEST q(
525b39c5158Smillert	 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
526b39c5158Smillert				[qw(*kennels *dogs *mutts)] );
527b39c5158Smillert	 $d->Dump;
528b39c5158Smillert	);
529b39c5158Smillert  if ($XS) {
530b39c5158Smillert    TEST q(
531b39c5158Smillert	   $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
532b39c5158Smillert				  [qw(*kennels *dogs *mutts)] );
533b39c5158Smillert	   $d->Dumpxs;
534b39c5158Smillert	  );
535b39c5158Smillert  }
536b39c5158Smillert
537b39c5158Smillert############# 91
538b39c5158Smillert##
539b39c5158Smillert  $WANT = <<'EOT';
540b39c5158Smillert#%kennels = %kennels;
541b39c5158Smillert#@dogs = @dogs;
542b39c5158Smillert#%mutts = %kennels;
543b39c5158SmillertEOT
544b39c5158Smillert
545b39c5158Smillert  TEST q($d->Dump);
546b39c5158Smillert  TEST q($d->Dumpxs) if $XS;
547b39c5158Smillert
548b39c5158Smillert############# 97
549b39c5158Smillert##
550b39c5158Smillert  $WANT = <<'EOT';
551b39c5158Smillert#%kennels = (
552b39c5158Smillert#  First => \'Fido',
553b39c5158Smillert#  Second => \'Wags'
554b39c5158Smillert#);
555b39c5158Smillert#@dogs = (
556b39c5158Smillert#  ${$kennels{First}},
557b39c5158Smillert#  ${$kennels{Second}},
558b39c5158Smillert#  \%kennels
559b39c5158Smillert#);
560b39c5158Smillert#%mutts = %kennels;
561b39c5158SmillertEOT
562b39c5158Smillert
563b39c5158Smillert
564b39c5158Smillert  TEST q($d->Reset; $d->Dump);
565b39c5158Smillert  if ($XS) {
566b39c5158Smillert    TEST q($d->Reset; $d->Dumpxs);
567b39c5158Smillert  }
568b39c5158Smillert
569b39c5158Smillert############# 103
570b39c5158Smillert##
571b39c5158Smillert  $WANT = <<'EOT';
572b39c5158Smillert#@dogs = (
573b39c5158Smillert#  'Fido',
574b39c5158Smillert#  'Wags',
575b39c5158Smillert#  {
576b39c5158Smillert#    First => \$dogs[0],
577b39c5158Smillert#    Second => \$dogs[1]
578b39c5158Smillert#  }
579b39c5158Smillert#);
580b39c5158Smillert#%kennels = %{$dogs[2]};
581b39c5158Smillert#%mutts = %{$dogs[2]};
582b39c5158SmillertEOT
583b39c5158Smillert
584b39c5158Smillert  TEST q(
585b39c5158Smillert	 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
586b39c5158Smillert				[qw(*dogs *kennels *mutts)] );
587b39c5158Smillert	 $d->Dump;
588b39c5158Smillert	);
589b39c5158Smillert  if ($XS) {
590b39c5158Smillert    TEST q(
591b39c5158Smillert	   $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
592b39c5158Smillert				  [qw(*dogs *kennels *mutts)] );
593b39c5158Smillert	   $d->Dumpxs;
594b39c5158Smillert	  );
595b39c5158Smillert  }
596b39c5158Smillert
597b39c5158Smillert############# 109
598b39c5158Smillert##
599b39c5158Smillert  TEST q($d->Reset->Dump);
600b39c5158Smillert  if ($XS) {
601b39c5158Smillert    TEST q($d->Reset->Dumpxs);
602b39c5158Smillert  }
603b39c5158Smillert
604b39c5158Smillert############# 115
605b39c5158Smillert##
606b39c5158Smillert  $WANT = <<'EOT';
607b39c5158Smillert#@dogs = (
608b39c5158Smillert#  'Fido',
609b39c5158Smillert#  'Wags',
610b39c5158Smillert#  {
611b39c5158Smillert#    First => \'Fido',
612b39c5158Smillert#    Second => \'Wags'
613b39c5158Smillert#  }
614b39c5158Smillert#);
615b39c5158Smillert#%kennels = (
616b39c5158Smillert#  First => \'Fido',
617b39c5158Smillert#  Second => \'Wags'
618b39c5158Smillert#);
619b39c5158SmillertEOT
620b39c5158Smillert
621b39c5158Smillert  TEST q(
622b39c5158Smillert	 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
623b39c5158Smillert	 $d->Deepcopy(1)->Dump;
624b39c5158Smillert	);
625b39c5158Smillert  if ($XS) {
626b39c5158Smillert    TEST q($d->Reset->Dumpxs);
627b39c5158Smillert  }
628b39c5158Smillert
629b39c5158Smillert}
630b39c5158Smillert
631b39c5158Smillert{
632b39c5158Smillert
633b39c5158Smillertsub z { print "foo\n" }
634b39c5158Smillert$c = [ \&z ];
635b39c5158Smillert
636b39c5158Smillert############# 121
637b39c5158Smillert##
638b39c5158Smillert  $WANT = <<'EOT';
639b39c5158Smillert#$a = $b;
640b39c5158Smillert#$c = [
641b39c5158Smillert#  $b
642b39c5158Smillert#];
643b39c5158SmillertEOT
644b39c5158Smillert
645b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
646b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
647b39c5158Smillert	if $XS;
648b39c5158Smillert
649b39c5158Smillert############# 127
650b39c5158Smillert##
651b39c5158Smillert  $WANT = <<'EOT';
652b39c5158Smillert#$a = \&b;
653b39c5158Smillert#$c = [
654b39c5158Smillert#  \&b
655b39c5158Smillert#];
656b39c5158SmillertEOT
657b39c5158Smillert
658b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
659b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
660b39c5158Smillert	if $XS;
661b39c5158Smillert
662b39c5158Smillert############# 133
663b39c5158Smillert##
664b39c5158Smillert  $WANT = <<'EOT';
665b39c5158Smillert#*a = \&b;
666b39c5158Smillert#@c = (
667b39c5158Smillert#  \&b
668b39c5158Smillert#);
669b39c5158SmillertEOT
670b39c5158Smillert
671b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
672b39c5158SmillertTEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
673b39c5158Smillert	if $XS;
674b39c5158Smillert
675b39c5158Smillert}
676b39c5158Smillert
677b39c5158Smillert{
678b39c5158Smillert  $a = [];
679b39c5158Smillert  $a->[1] = \$a->[0];
680b39c5158Smillert
681b39c5158Smillert############# 139
682b39c5158Smillert##
683b39c5158Smillert  $WANT = <<'EOT';
684b39c5158Smillert#@a = (
685b39c5158Smillert#  undef,
686b39c5158Smillert#  do{my $o}
687b39c5158Smillert#);
688b39c5158Smillert#$a[1] = \$a[0];
689b39c5158SmillertEOT
690b39c5158Smillert
691b39c5158SmillertTEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
692b39c5158SmillertTEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
693b39c5158Smillert	if $XS;
694b39c5158Smillert}
695b39c5158Smillert
696b39c5158Smillert{
697b39c5158Smillert  $a = \\\\\'foo';
698b39c5158Smillert  $b = $$$a;
699b39c5158Smillert
700b39c5158Smillert############# 145
701b39c5158Smillert##
702b39c5158Smillert  $WANT = <<'EOT';
703b39c5158Smillert#$a = \\\\\'foo';
704b39c5158Smillert#$b = ${${$a}};
705b39c5158SmillertEOT
706b39c5158Smillert
707b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
708b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
709b39c5158Smillert	if $XS;
710b39c5158Smillert}
711b39c5158Smillert
712b39c5158Smillert{
713b39c5158Smillert  $a = [{ a => \$b }, { b => undef }];
714b39c5158Smillert  $b = [{ c => \$b }, { d => \$a }];
715b39c5158Smillert
716b39c5158Smillert############# 151
717b39c5158Smillert##
718b39c5158Smillert  $WANT = <<'EOT';
719b39c5158Smillert#$a = [
720b39c5158Smillert#  {
721b39c5158Smillert#    a => \[
722b39c5158Smillert#        {
723b39c5158Smillert#          c => do{my $o}
724b39c5158Smillert#        },
725b39c5158Smillert#        {
726b39c5158Smillert#          d => \[]
727b39c5158Smillert#        }
728b39c5158Smillert#      ]
729b39c5158Smillert#  },
730b39c5158Smillert#  {
731b39c5158Smillert#    b => undef
732b39c5158Smillert#  }
733b39c5158Smillert#];
734b39c5158Smillert#${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
735b39c5158Smillert#${${$a->[0]{a}}->[1]->{d}} = $a;
736b39c5158Smillert#$b = ${$a->[0]{a}};
737b39c5158SmillertEOT
738b39c5158Smillert
739b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
740b39c5158SmillertTEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
741b39c5158Smillert	if $XS;
742b39c5158Smillert}
743b39c5158Smillert
744b39c5158Smillert{
745b39c5158Smillert  $a = [[[[\\\\\'foo']]]];
746b39c5158Smillert  $b = $a->[0][0];
747b39c5158Smillert  $c = $${$b->[0][0]};
748b39c5158Smillert
749b39c5158Smillert############# 157
750b39c5158Smillert##
751b39c5158Smillert  $WANT = <<'EOT';
752b39c5158Smillert#$a = [
753b39c5158Smillert#  [
754b39c5158Smillert#    [
755b39c5158Smillert#      [
756b39c5158Smillert#        \\\\\'foo'
757b39c5158Smillert#      ]
758b39c5158Smillert#    ]
759b39c5158Smillert#  ]
760b39c5158Smillert#];
761b39c5158Smillert#$b = $a->[0][0];
762b39c5158Smillert#$c = ${${$a->[0][0][0][0]}};
763b39c5158SmillertEOT
764b39c5158Smillert
765b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
766b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
767b39c5158Smillert	if $XS;
768b39c5158Smillert}
769b39c5158Smillert
770b39c5158Smillert{
771b39c5158Smillert    $f = "pearl";
772b39c5158Smillert    $e = [        $f ];
773b39c5158Smillert    $d = { 'e' => $e };
774b39c5158Smillert    $c = [        $d ];
775b39c5158Smillert    $b = { 'c' => $c };
776b39c5158Smillert    $a = { 'b' => $b };
777b39c5158Smillert
778b39c5158Smillert############# 163
779b39c5158Smillert##
780b39c5158Smillert  $WANT = <<'EOT';
781b39c5158Smillert#$a = {
782b39c5158Smillert#  b => {
783b39c5158Smillert#    c => [
784b39c5158Smillert#      {
785b39c5158Smillert#        e => 'ARRAY(0xdeadbeef)'
786b39c5158Smillert#      }
787b39c5158Smillert#    ]
788b39c5158Smillert#  }
789b39c5158Smillert#};
790b39c5158Smillert#$b = $a->{b};
791b39c5158Smillert#$c = $a->{b}{c};
792b39c5158SmillertEOT
793b39c5158Smillert
794b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
795b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
796b39c5158Smillert	if $XS;
797b39c5158Smillert
798b39c5158Smillert############# 169
799b39c5158Smillert##
800b39c5158Smillert  $WANT = <<'EOT';
801b39c5158Smillert#$a = {
802b39c5158Smillert#  b => 'HASH(0xdeadbeef)'
803b39c5158Smillert#};
804b39c5158Smillert#$b = $a->{b};
805b39c5158Smillert#$c = [
806b39c5158Smillert#  'HASH(0xdeadbeef)'
807b39c5158Smillert#];
808b39c5158SmillertEOT
809b39c5158Smillert
810b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
811b39c5158SmillertTEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
812b39c5158Smillert	if $XS;
813b39c5158Smillert}
814b39c5158Smillert
815b39c5158Smillert{
816b39c5158Smillert    $a = \$a;
817b39c5158Smillert    $b = [$a];
818b39c5158Smillert
819b39c5158Smillert############# 175
820b39c5158Smillert##
821b39c5158Smillert  $WANT = <<'EOT';
822b39c5158Smillert#$b = [
823b39c5158Smillert#  \$b->[0]
824b39c5158Smillert#];
825b39c5158SmillertEOT
826b39c5158Smillert
827b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
828b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
829b39c5158Smillert	if $XS;
830b39c5158Smillert
831b39c5158Smillert############# 181
832b39c5158Smillert##
833b39c5158Smillert  $WANT = <<'EOT';
834b39c5158Smillert#$b = [
835b39c5158Smillert#  \do{my $o}
836b39c5158Smillert#];
837b39c5158Smillert#${$b->[0]} = $b->[0];
838b39c5158SmillertEOT
839b39c5158Smillert
840b39c5158Smillert
841b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
842b39c5158SmillertTEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
843b39c5158Smillert	if $XS;
844b39c5158Smillert}
845b39c5158Smillert
846b39c5158Smillert{
847b39c5158Smillert  $a = "\x{09c10}";
848b39c5158Smillert############# 187
849b39c5158Smillert## XS code was adding an extra \0
850b39c5158Smillert  $WANT = <<'EOT';
851b39c5158Smillert#$a = "\x{9c10}";
852b39c5158SmillertEOT
853b39c5158Smillert
854b39c5158Smillert  if($] >= 5.007) {
855b39c5158Smillert    TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}";
856b39c5158Smillert  } else {
857b39c5158Smillert    SKIP_TEST "Incomplete support for UTF-8 in old perls";
858b39c5158Smillert  }
859b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([$a], ['a'])), "XS \\x{9c10}"
860b39c5158Smillert	if $XS;
861b39c5158Smillert}
862b39c5158Smillert
863b39c5158Smillert{
864b39c5158Smillert  $i = 0;
865b39c5158Smillert  $a = { map { ("$_$_$_", ++$i) } 'I'..'Q' };
866b39c5158Smillert
867b39c5158Smillert############# 193
868b39c5158Smillert##
869b39c5158Smillert  $WANT = <<'EOT';
870b39c5158Smillert#$VAR1 = {
871b39c5158Smillert#  III => 1,
872b39c5158Smillert#  JJJ => 2,
873b39c5158Smillert#  KKK => 3,
874b39c5158Smillert#  LLL => 4,
875b39c5158Smillert#  MMM => 5,
876b39c5158Smillert#  NNN => 6,
877b39c5158Smillert#  OOO => 7,
878b39c5158Smillert#  PPP => 8,
879b39c5158Smillert#  QQQ => 9
880b39c5158Smillert#};
881b39c5158SmillertEOT
882b39c5158Smillert
883b39c5158SmillertTEST q(Data::Dumper->new([$a])->Dump;);
884b39c5158SmillertTEST q(Data::Dumper->new([$a])->Dumpxs;)
885b39c5158Smillert	if $XS;
886b39c5158Smillert}
887b39c5158Smillert
888b39c5158Smillert{
889b39c5158Smillert  $i = 5;
890b39c5158Smillert  $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
891b39c5158Smillert  local $Data::Dumper::Sortkeys = \&sort199;
892b39c5158Smillert  sub sort199 {
893b39c5158Smillert    my $hash = shift;
894b39c5158Smillert    return [ sort { $b <=> $a } keys %$hash ];
895b39c5158Smillert  }
896b39c5158Smillert
897b39c5158Smillert############# 199
898b39c5158Smillert##
899b39c5158Smillert  $WANT = <<'EOT';
900b39c5158Smillert#$VAR1 = {
901b39c5158Smillert#  14 => 'QQQ',
902b39c5158Smillert#  13 => 'PPP',
903b39c5158Smillert#  12 => 'OOO',
904b39c5158Smillert#  11 => 'NNN',
905b39c5158Smillert#  10 => 'MMM',
906b39c5158Smillert#  9 => 'LLL',
907b39c5158Smillert#  8 => 'KKK',
908b39c5158Smillert#  7 => 'JJJ',
909b39c5158Smillert#  6 => 'III'
910b39c5158Smillert#};
911b39c5158SmillertEOT
912b39c5158Smillert
913b39c5158Smillert# perl code does keys and values as numbers if possible
914b39c5158SmillertTEST q(Data::Dumper->new([$c])->Dump;);
915b39c5158Smillert# XS code always does them as strings
916b39c5158Smillert$WANT =~ s/ (\d+)/ '$1'/gs;
917b39c5158SmillertTEST q(Data::Dumper->new([$c])->Dumpxs;)
918b39c5158Smillert	if $XS;
919b39c5158Smillert}
920b39c5158Smillert
921b39c5158Smillert{
922b39c5158Smillert  $i = 5;
923b39c5158Smillert  $c = { map { (++$i, "$_$_$_") } 'I'..'Q' };
924b39c5158Smillert  $d = { reverse %$c };
925b39c5158Smillert  local $Data::Dumper::Sortkeys = \&sort205;
926b39c5158Smillert  sub sort205 {
927b39c5158Smillert    my $hash = shift;
928b39c5158Smillert    return [
929b39c5158Smillert      $hash eq $c ? (sort { $a <=> $b } keys %$hash)
930b39c5158Smillert		  : (reverse sort keys %$hash)
931b39c5158Smillert    ];
932b39c5158Smillert  }
933b39c5158Smillert
934b39c5158Smillert############# 205
935b39c5158Smillert##
936b39c5158Smillert  $WANT = <<'EOT';
937b39c5158Smillert#$VAR1 = [
938b39c5158Smillert#  {
939b39c5158Smillert#    6 => 'III',
940b39c5158Smillert#    7 => 'JJJ',
941b39c5158Smillert#    8 => 'KKK',
942b39c5158Smillert#    9 => 'LLL',
943b39c5158Smillert#    10 => 'MMM',
944b39c5158Smillert#    11 => 'NNN',
945b39c5158Smillert#    12 => 'OOO',
946b39c5158Smillert#    13 => 'PPP',
947b39c5158Smillert#    14 => 'QQQ'
948b39c5158Smillert#  },
949b39c5158Smillert#  {
950b39c5158Smillert#    QQQ => 14,
951b39c5158Smillert#    PPP => 13,
952b39c5158Smillert#    OOO => 12,
953b39c5158Smillert#    NNN => 11,
954b39c5158Smillert#    MMM => 10,
955b39c5158Smillert#    LLL => 9,
956b39c5158Smillert#    KKK => 8,
957b39c5158Smillert#    JJJ => 7,
958b39c5158Smillert#    III => 6
959b39c5158Smillert#  }
960b39c5158Smillert#];
961b39c5158SmillertEOT
962b39c5158Smillert
963b39c5158SmillertTEST q(Data::Dumper->new([[$c, $d]])->Dump;);
964b39c5158Smillert$WANT =~ s/ (\d+)/ '$1'/gs;
965b39c5158SmillertTEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;)
966b39c5158Smillert	if $XS;
967b39c5158Smillert}
968b39c5158Smillert
969b39c5158Smillert{
970b39c5158Smillert  local $Data::Dumper::Deparse = 1;
971b39c5158Smillert  local $Data::Dumper::Indent = 2;
972b39c5158Smillert
973b39c5158Smillert############# 211
974b39c5158Smillert##
975b39c5158Smillert  $WANT = <<'EOT';
976b39c5158Smillert#$VAR1 = {
977b39c5158Smillert#          foo => sub {
978b39c5158Smillert#                     print 'foo';
979b39c5158Smillert#                 }
980b39c5158Smillert#        };
981b39c5158SmillertEOT
982b39c5158Smillert
983b39c5158Smillert  if(" $Config{'extensions'} " !~ m[ B ]) {
984b39c5158Smillert    SKIP_TEST "Perl configured without B module";
985b39c5158Smillert  } else {
986b39c5158Smillert    TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump);
987b39c5158Smillert  }
988b39c5158Smillert}
989b39c5158Smillert
990b39c5158Smillert############# 214
991b39c5158Smillert##
992b39c5158Smillert
993b39c5158Smillert# This is messy.
994b39c5158Smillert# The controls (bare numbers) are stored either as integers or floating point.
995b39c5158Smillert# [depending on whether the tokeniser sees things like ".".
996b39c5158Smillert# The peephole optimiser only runs for constant folding, not single constants,
997b39c5158Smillert# so I already have some NVs, some IVs
998b39c5158Smillert# The string versions are not. They are all PV
999b39c5158Smillert
1000b39c5158Smillert# This is arguably all far too chummy with the implementation, but I really
1001b39c5158Smillert# want to ensure that we don't go wrong when flags on scalars get as side
1002b39c5158Smillert# effects of reading them.
1003b39c5158Smillert
1004b39c5158Smillert# These tests are actually testing the precise output of the current
1005b39c5158Smillert# implementation, so will most likely fail if the implementation changes,
1006b39c5158Smillert# even if the new implementation produces different but correct results.
1007b39c5158Smillert# It would be nice to test for wrong answers, but I can't see how to do that,
1008b39c5158Smillert# so instead I'm checking for unexpected answers. (ie -2 becoming "-2" is not
1009b39c5158Smillert# wrong, but I can't see an easy, reliable way to code that knowledge)
1010b39c5158Smillert
1011b39c5158Smillert# Numbers (seen by the tokeniser as numbers, stored as numbers.
1012b39c5158Smillert  @numbers =
1013b39c5158Smillert  (
1014b39c5158Smillert   0, +1, -2, 3.0, +4.0, -5.0, 6.5, +7.5, -8.5,
1015b39c5158Smillert    9,  +10,  -11,  12.0,  +13.0,  -14.0,  15.5,  +16.25,  -17.75,
1016b39c5158Smillert  );
1017b39c5158Smillert# Strings
1018b39c5158Smillert  @strings =
1019b39c5158Smillert  (
1020b39c5158Smillert   "0", "+1", "-2", "3.0", "+4.0", "-5.0", "6.5", "+7.5", "-8.5", " 9",
1021b39c5158Smillert   " +10", " -11", " 12.0", " +13.0", " -14.0", " 15.5", " +16.25", " -17.75",
1022b39c5158Smillert  );
1023b39c5158Smillert
1024b39c5158Smillert# The perl code always does things the same way for numbers.
1025b39c5158Smillert  $WANT_PL_N = <<'EOT';
1026b39c5158Smillert#$VAR1 = 0;
1027b39c5158Smillert#$VAR2 = 1;
1028b39c5158Smillert#$VAR3 = -2;
1029b39c5158Smillert#$VAR4 = 3;
1030b39c5158Smillert#$VAR5 = 4;
1031b39c5158Smillert#$VAR6 = -5;
1032b39c5158Smillert#$VAR7 = '6.5';
1033b39c5158Smillert#$VAR8 = '7.5';
1034b39c5158Smillert#$VAR9 = '-8.5';
1035b39c5158Smillert#$VAR10 = 9;
1036b39c5158Smillert#$VAR11 = 10;
1037b39c5158Smillert#$VAR12 = -11;
1038b39c5158Smillert#$VAR13 = 12;
1039b39c5158Smillert#$VAR14 = 13;
1040b39c5158Smillert#$VAR15 = -14;
1041b39c5158Smillert#$VAR16 = '15.5';
1042b39c5158Smillert#$VAR17 = '16.25';
1043b39c5158Smillert#$VAR18 = '-17.75';
1044b39c5158SmillertEOT
1045b39c5158Smillert# The perl code knows that 0 and -2 stringify exactly back to the strings,
1046b39c5158Smillert# so it dumps them as numbers, not strings.
1047b39c5158Smillert  $WANT_PL_S = <<'EOT';
1048b39c5158Smillert#$VAR1 = 0;
1049b39c5158Smillert#$VAR2 = '+1';
1050b39c5158Smillert#$VAR3 = -2;
1051b39c5158Smillert#$VAR4 = '3.0';
1052b39c5158Smillert#$VAR5 = '+4.0';
1053b39c5158Smillert#$VAR6 = '-5.0';
1054b39c5158Smillert#$VAR7 = '6.5';
1055b39c5158Smillert#$VAR8 = '+7.5';
1056b39c5158Smillert#$VAR9 = '-8.5';
1057b39c5158Smillert#$VAR10 = ' 9';
1058b39c5158Smillert#$VAR11 = ' +10';
1059b39c5158Smillert#$VAR12 = ' -11';
1060b39c5158Smillert#$VAR13 = ' 12.0';
1061b39c5158Smillert#$VAR14 = ' +13.0';
1062b39c5158Smillert#$VAR15 = ' -14.0';
1063b39c5158Smillert#$VAR16 = ' 15.5';
1064b39c5158Smillert#$VAR17 = ' +16.25';
1065b39c5158Smillert#$VAR18 = ' -17.75';
1066b39c5158SmillertEOT
1067b39c5158Smillert
1068b39c5158Smillert# The XS code differs.
1069b39c5158Smillert# These are the numbers as seen by the tokeniser. Constants aren't folded
1070b39c5158Smillert# (which makes IVs where possible) so values the tokeniser thought were
1071b39c5158Smillert# floating point are stored as NVs. The XS code outputs these as strings,
1072b39c5158Smillert# but as it has converted them from NVs, leading + signs will not be there.
1073b39c5158Smillert  $WANT_XS_N = <<'EOT';
1074b39c5158Smillert#$VAR1 = 0;
1075b39c5158Smillert#$VAR2 = 1;
1076b39c5158Smillert#$VAR3 = -2;
1077b39c5158Smillert#$VAR4 = '3';
1078b39c5158Smillert#$VAR5 = '4';
1079b39c5158Smillert#$VAR6 = '-5';
1080b39c5158Smillert#$VAR7 = '6.5';
1081b39c5158Smillert#$VAR8 = '7.5';
1082b39c5158Smillert#$VAR9 = '-8.5';
1083b39c5158Smillert#$VAR10 = 9;
1084b39c5158Smillert#$VAR11 = 10;
1085b39c5158Smillert#$VAR12 = -11;
1086b39c5158Smillert#$VAR13 = '12';
1087b39c5158Smillert#$VAR14 = '13';
1088b39c5158Smillert#$VAR15 = '-14';
1089b39c5158Smillert#$VAR16 = '15.5';
1090b39c5158Smillert#$VAR17 = '16.25';
1091b39c5158Smillert#$VAR18 = '-17.75';
1092b39c5158SmillertEOT
1093b39c5158Smillert
1094b39c5158Smillert# These are the strings as seen by the tokeniser. The XS code will output
1095b39c5158Smillert# these for all cases except where the scalar has been used in integer context
1096b39c5158Smillert  $WANT_XS_S = <<'EOT';
1097b39c5158Smillert#$VAR1 = '0';
1098b39c5158Smillert#$VAR2 = '+1';
1099b39c5158Smillert#$VAR3 = '-2';
1100b39c5158Smillert#$VAR4 = '3.0';
1101b39c5158Smillert#$VAR5 = '+4.0';
1102b39c5158Smillert#$VAR6 = '-5.0';
1103b39c5158Smillert#$VAR7 = '6.5';
1104b39c5158Smillert#$VAR8 = '+7.5';
1105b39c5158Smillert#$VAR9 = '-8.5';
1106b39c5158Smillert#$VAR10 = ' 9';
1107b39c5158Smillert#$VAR11 = ' +10';
1108b39c5158Smillert#$VAR12 = ' -11';
1109b39c5158Smillert#$VAR13 = ' 12.0';
1110b39c5158Smillert#$VAR14 = ' +13.0';
1111b39c5158Smillert#$VAR15 = ' -14.0';
1112b39c5158Smillert#$VAR16 = ' 15.5';
1113b39c5158Smillert#$VAR17 = ' +16.25';
1114b39c5158Smillert#$VAR18 = ' -17.75';
1115b39c5158SmillertEOT
1116b39c5158Smillert
1117b39c5158Smillert# These are the numbers as IV-ized by &
1118b39c5158Smillert# These will differ from WANT_XS_N because now IV flags will be set on all
1119b39c5158Smillert# values that were actually integer, and the XS code will then output these
1120b39c5158Smillert# as numbers not strings.
1121b39c5158Smillert  $WANT_XS_I = <<'EOT';
1122b39c5158Smillert#$VAR1 = 0;
1123b39c5158Smillert#$VAR2 = 1;
1124b39c5158Smillert#$VAR3 = -2;
1125b39c5158Smillert#$VAR4 = 3;
1126b39c5158Smillert#$VAR5 = 4;
1127b39c5158Smillert#$VAR6 = -5;
1128b39c5158Smillert#$VAR7 = '6.5';
1129b39c5158Smillert#$VAR8 = '7.5';
1130b39c5158Smillert#$VAR9 = '-8.5';
1131b39c5158Smillert#$VAR10 = 9;
1132b39c5158Smillert#$VAR11 = 10;
1133b39c5158Smillert#$VAR12 = -11;
1134b39c5158Smillert#$VAR13 = 12;
1135b39c5158Smillert#$VAR14 = 13;
1136b39c5158Smillert#$VAR15 = -14;
1137b39c5158Smillert#$VAR16 = '15.5';
1138b39c5158Smillert#$VAR17 = '16.25';
1139b39c5158Smillert#$VAR18 = '-17.75';
1140b39c5158SmillertEOT
1141b39c5158Smillert
1142b39c5158Smillert# Some of these tests will be redundant.
1143b39c5158Smillert@numbers_s = @numbers_i = @numbers_is = @numbers_n = @numbers_ns = @numbers_ni
1144b39c5158Smillert  = @numbers_nis = @numbers;
1145b39c5158Smillert@strings_s = @strings_i = @strings_is = @strings_n = @strings_ns = @strings_ni
1146b39c5158Smillert  = @strings_nis = @strings;
1147b39c5158Smillert# Use them in an integer context
1148b39c5158Smillertforeach (@numbers_i, @numbers_ni, @numbers_nis, @numbers_is,
1149b39c5158Smillert         @strings_i, @strings_ni, @strings_nis, @strings_is) {
1150b39c5158Smillert  my $b = sprintf "%d", $_;
1151b39c5158Smillert}
1152b39c5158Smillert# Use them in a floating point context
1153b39c5158Smillertforeach (@numbers_n, @numbers_ni, @numbers_nis, @numbers_ns,
1154b39c5158Smillert         @strings_n, @strings_ni, @strings_nis, @strings_ns) {
1155b39c5158Smillert  my $b = sprintf "%e", $_;
1156b39c5158Smillert}
1157b39c5158Smillert# Use them in a string context
1158b39c5158Smillertforeach (@numbers_s, @numbers_is, @numbers_nis, @numbers_ns,
1159b39c5158Smillert         @strings_s, @strings_is, @strings_nis, @strings_ns) {
1160b39c5158Smillert  my $b = sprintf "%s", $_;
1161b39c5158Smillert}
1162b39c5158Smillert
1163b39c5158Smillert# use Devel::Peek; Dump ($_) foreach @vanilla_c;
1164b39c5158Smillert
1165b39c5158Smillert$WANT=$WANT_PL_N;
1166b39c5158SmillertTEST q(Data::Dumper->new(\@numbers)->Dump), 'Numbers';
1167b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_s)->Dump), 'Numbers PV';
1168b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_i)->Dump), 'Numbers IV';
1169b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_is)->Dump), 'Numbers IV,PV';
1170b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_n)->Dump), 'Numbers NV';
1171b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_ns)->Dump), 'Numbers NV,PV';
1172b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_ni)->Dump), 'Numbers NV,IV';
1173b39c5158SmillertTEST q(Data::Dumper->new(\@numbers_nis)->Dump), 'Numbers NV,IV,PV';
1174b39c5158Smillert$WANT=$WANT_PL_S;
1175b39c5158SmillertTEST q(Data::Dumper->new(\@strings)->Dump), 'Strings';
1176b39c5158SmillertTEST q(Data::Dumper->new(\@strings_s)->Dump), 'Strings PV';
1177b39c5158SmillertTEST q(Data::Dumper->new(\@strings_i)->Dump), 'Strings IV';
1178b39c5158SmillertTEST q(Data::Dumper->new(\@strings_is)->Dump), 'Strings IV,PV';
1179b39c5158SmillertTEST q(Data::Dumper->new(\@strings_n)->Dump), 'Strings NV';
1180b39c5158SmillertTEST q(Data::Dumper->new(\@strings_ns)->Dump), 'Strings NV,PV';
1181b39c5158SmillertTEST q(Data::Dumper->new(\@strings_ni)->Dump), 'Strings NV,IV';
1182b39c5158SmillertTEST q(Data::Dumper->new(\@strings_nis)->Dump), 'Strings NV,IV,PV';
1183b39c5158Smillertif ($XS) {
1184b39c5158Smillert my $nv_preserves_uv = defined $Config{d_nv_preserves_uv};
1185b39c5158Smillert my $nv_preserves_uv_4bits = exists($Config{nv_preserves_uv_bits}) && $Config{nv_preserves_uv_bits} >= 4;
1186b39c5158Smillert  $WANT=$WANT_XS_N;
1187b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers)->Dumpxs), 'XS Numbers';
1188b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers_s)->Dumpxs), 'XS Numbers PV';
1189b39c5158Smillert if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1190b39c5158Smillert  $WANT=$WANT_XS_I;
1191b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers_i)->Dumpxs), 'XS Numbers IV';
1192b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers_is)->Dumpxs), 'XS Numbers IV,PV';
1193b39c5158Smillert } else {
1194b39c5158Smillert  SKIP_TEST "NV does not preserve 4bits";
1195b39c5158Smillert  SKIP_TEST "NV does not preserve 4bits";
1196b39c5158Smillert }
1197b39c5158Smillert  $WANT=$WANT_XS_N;
1198b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers_n)->Dumpxs), 'XS Numbers NV';
1199b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers_ns)->Dumpxs), 'XS Numbers NV,PV';
1200b39c5158Smillert if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1201b39c5158Smillert  $WANT=$WANT_XS_I;
1202b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers_ni)->Dumpxs), 'XS Numbers NV,IV';
1203b39c5158Smillert  TEST q(Data::Dumper->new(\@numbers_nis)->Dumpxs), 'XS Numbers NV,IV,PV';
1204b39c5158Smillert } else {
1205b39c5158Smillert  SKIP_TEST "NV does not preserve 4bits";
1206b39c5158Smillert  SKIP_TEST "NV does not preserve 4bits";
1207b39c5158Smillert }
1208b39c5158Smillert
1209b39c5158Smillert  $WANT=$WANT_XS_S;
1210b39c5158Smillert  TEST q(Data::Dumper->new(\@strings)->Dumpxs), 'XS Strings';
1211b39c5158Smillert  TEST q(Data::Dumper->new(\@strings_s)->Dumpxs), 'XS Strings PV';
1212b39c5158Smillert  # This one used to really mess up. New code actually emulates the .pm code
1213b39c5158Smillert  $WANT=$WANT_PL_S;
1214b39c5158Smillert  TEST q(Data::Dumper->new(\@strings_i)->Dumpxs), 'XS Strings IV';
1215b39c5158Smillert  TEST q(Data::Dumper->new(\@strings_is)->Dumpxs), 'XS Strings IV,PV';
1216b39c5158Smillert if ($nv_preserves_uv || $nv_preserves_uv_4bits) {
1217b39c5158Smillert  $WANT=$WANT_XS_S;
1218b39c5158Smillert  TEST q(Data::Dumper->new(\@strings_n)->Dumpxs), 'XS Strings NV';
1219b39c5158Smillert  TEST q(Data::Dumper->new(\@strings_ns)->Dumpxs), 'XS Strings NV,PV';
1220b39c5158Smillert } else {
1221b39c5158Smillert  SKIP_TEST "NV does not preserve 4bits";
1222b39c5158Smillert  SKIP_TEST "NV does not preserve 4bits";
1223b39c5158Smillert }
1224b39c5158Smillert  # This one used to really mess up. New code actually emulates the .pm code
1225b39c5158Smillert  $WANT=$WANT_PL_S;
1226b39c5158Smillert  TEST q(Data::Dumper->new(\@strings_ni)->Dumpxs), 'XS Strings NV,IV';
1227b39c5158Smillert  TEST q(Data::Dumper->new(\@strings_nis)->Dumpxs), 'XS Strings NV,IV,PV';
1228b39c5158Smillert}
1229b39c5158Smillert
1230b39c5158Smillert{
1231b39c5158Smillert  $a = "1\n";
1232b39c5158Smillert############# 310
1233b39c5158Smillert## Perl code was using /...$/ and hence missing the \n.
1234b39c5158Smillert  $WANT = <<'EOT';
1235b39c5158Smillertmy $VAR1 = '42
1236b39c5158Smillert';
1237b39c5158SmillertEOT
1238b39c5158Smillert
1239b39c5158Smillert  # Can't pad with # as the output has an embedded newline.
1240b39c5158Smillert  local $Data::Dumper::Pad = "my ";
1241b39c5158Smillert  TEST q(Data::Dumper->Dump(["42\n"])), "number with trailing newline";
1242b39c5158Smillert  TEST q(Data::Dumper->Dumpxs(["42\n"])), "XS number with trailing newline"
1243b39c5158Smillert	if $XS;
1244b39c5158Smillert}
1245b39c5158Smillert
1246b39c5158Smillert{
1247b39c5158Smillert  @a = (
1248b39c5158Smillert        999999999,
1249b39c5158Smillert        1000000000,
1250b39c5158Smillert        9999999999,
1251b39c5158Smillert        10000000000,
1252b39c5158Smillert        -999999999,
1253b39c5158Smillert        -1000000000,
1254b39c5158Smillert        -9999999999,
1255b39c5158Smillert        -10000000000,
1256b39c5158Smillert        4294967295,
1257b39c5158Smillert        4294967296,
1258b39c5158Smillert        -2147483648,
1259b39c5158Smillert        -2147483649,
1260b39c5158Smillert        );
1261b39c5158Smillert############# 316
1262b39c5158Smillert## Perl code flips over at 10 digits.
1263b39c5158Smillert  $WANT = <<'EOT';
1264b39c5158Smillert#$VAR1 = 999999999;
1265b39c5158Smillert#$VAR2 = '1000000000';
1266b39c5158Smillert#$VAR3 = '9999999999';
1267b39c5158Smillert#$VAR4 = '10000000000';
1268b39c5158Smillert#$VAR5 = -999999999;
1269b39c5158Smillert#$VAR6 = '-1000000000';
1270b39c5158Smillert#$VAR7 = '-9999999999';
1271b39c5158Smillert#$VAR8 = '-10000000000';
1272b39c5158Smillert#$VAR9 = '4294967295';
1273b39c5158Smillert#$VAR10 = '4294967296';
1274b39c5158Smillert#$VAR11 = '-2147483648';
1275b39c5158Smillert#$VAR12 = '-2147483649';
1276b39c5158SmillertEOT
1277b39c5158Smillert
1278b39c5158Smillert  TEST q(Data::Dumper->Dump(\@a)), "long integers";
1279b39c5158Smillert
1280b39c5158Smillert  if ($XS) {
1281b39c5158Smillert## XS code flips over at 11 characters ("-" is a char) or larger than int.
1282b39c5158Smillert    if (~0 == 0xFFFFFFFF) {
1283b39c5158Smillert      # 32 bit system
1284b39c5158Smillert      $WANT = <<'EOT';
1285b39c5158Smillert#$VAR1 = 999999999;
1286b39c5158Smillert#$VAR2 = 1000000000;
1287b39c5158Smillert#$VAR3 = '9999999999';
1288b39c5158Smillert#$VAR4 = '10000000000';
1289b39c5158Smillert#$VAR5 = -999999999;
1290b39c5158Smillert#$VAR6 = '-1000000000';
1291b39c5158Smillert#$VAR7 = '-9999999999';
1292b39c5158Smillert#$VAR8 = '-10000000000';
1293b39c5158Smillert#$VAR9 = 4294967295;
1294b39c5158Smillert#$VAR10 = '4294967296';
1295b39c5158Smillert#$VAR11 = '-2147483648';
1296b39c5158Smillert#$VAR12 = '-2147483649';
1297b39c5158SmillertEOT
1298b39c5158Smillert    } else {
1299b39c5158Smillert      $WANT = <<'EOT';
1300b39c5158Smillert#$VAR1 = 999999999;
1301b39c5158Smillert#$VAR2 = 1000000000;
1302b39c5158Smillert#$VAR3 = 9999999999;
1303b39c5158Smillert#$VAR4 = '10000000000';
1304b39c5158Smillert#$VAR5 = -999999999;
1305b39c5158Smillert#$VAR6 = '-1000000000';
1306b39c5158Smillert#$VAR7 = '-9999999999';
1307b39c5158Smillert#$VAR8 = '-10000000000';
1308b39c5158Smillert#$VAR9 = 4294967295;
1309b39c5158Smillert#$VAR10 = 4294967296;
1310b39c5158Smillert#$VAR11 = '-2147483648';
1311b39c5158Smillert#$VAR12 = '-2147483649';
1312b39c5158SmillertEOT
1313b39c5158Smillert    }
1314b39c5158Smillert    TEST q(Data::Dumper->Dumpxs(\@a)), "XS long integers";
1315b39c5158Smillert  }
1316b39c5158Smillert}
1317b39c5158Smillert
1318b39c5158Smillert#XXX}
1319b39c5158Smillert{
1320b39c5158Smillert    if ($Is_ebcdic) {
1321b39c5158Smillert	$b = "Bad. XS didn't escape dollar sign";
1322b39c5158Smillert############# 322
1323b39c5158Smillert	$WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
1324b39c5158Smillert#\$VAR1 = '\$b\"\@\\\\\xB1';
1325b39c5158SmillertEOT
1326b39c5158Smillert        $a = "\$b\"\@\\\xB1\x{100}";
1327b39c5158Smillert	chop $a;
1328b39c5158Smillert	TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1329b39c5158Smillert	if ($XS) {
1330b39c5158Smillert	    $WANT = <<'EOT'; # While this is "" string written inside "" here doc
1331b39c5158Smillert#$VAR1 = "\$b\"\@\\\x{b1}";
1332b39c5158SmillertEOT
1333b39c5158Smillert            TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1334b39c5158Smillert	}
1335b39c5158Smillert    } else {
1336b39c5158Smillert	$b = "Bad. XS didn't escape dollar sign";
1337b39c5158Smillert############# 322
1338b39c5158Smillert	$WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
1339b39c5158Smillert#\$VAR1 = '\$b\"\@\\\\\xA3';
1340b39c5158SmillertEOT
1341b39c5158Smillert
1342b39c5158Smillert        $a = "\$b\"\@\\\xA3\x{100}";
1343b39c5158Smillert	chop $a;
1344b39c5158Smillert	TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1345b39c5158Smillert	if ($XS) {
1346b39c5158Smillert	    $WANT = <<'EOT'; # While this is "" string written inside "" here doc
1347b39c5158Smillert#$VAR1 = "\$b\"\@\\\x{a3}";
1348b39c5158SmillertEOT
1349b39c5158Smillert            TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1350b39c5158Smillert	}
1351b39c5158Smillert  }
1352b39c5158Smillert  # XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")]
1353b39c5158Smillert############# 328
1354b39c5158Smillert  $WANT = <<'EOT';
1355b39c5158Smillert#$VAR1 = '$b"';
1356b39c5158SmillertEOT
1357b39c5158Smillert
1358b39c5158Smillert  $a = "\$b\"\x{100}";
1359b39c5158Smillert  chop $a;
1360b39c5158Smillert  TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
1361b39c5158Smillert  if ($XS) {
1362b39c5158Smillert    TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
1363b39c5158Smillert  }
1364b39c5158Smillert
1365b39c5158Smillert
1366b39c5158Smillert  # XS used to produce 'D'oh!' which is well, D'oh!
1367b39c5158Smillert  # Andreas found this one, which in turn discovered the previous two.
1368b39c5158Smillert############# 334
1369b39c5158Smillert  $WANT = <<'EOT';
1370b39c5158Smillert#$VAR1 = 'D\'oh!';
1371b39c5158SmillertEOT
1372b39c5158Smillert
1373b39c5158Smillert  $a = "D'oh!\x{100}";
1374b39c5158Smillert  chop $a;
1375b39c5158Smillert  TEST q(Data::Dumper->Dump([$a])), "utf8 flag with '";
1376b39c5158Smillert  if ($XS) {
1377b39c5158Smillert    TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with '";
1378b39c5158Smillert  }
1379b39c5158Smillert}
1380b39c5158Smillert
1381b39c5158Smillert# Jarkko found that -Mutf8 caused some tests to fail.  Turns out that there
1382b39c5158Smillert# was an otherwise untested code path in the XS for utf8 hash keys with purity
1383b39c5158Smillert# 1
1384b39c5158Smillert
1385b39c5158Smillert{
1386b39c5158Smillert  $WANT = <<'EOT';
1387b39c5158Smillert#$ping = \*::ping;
1388b39c5158Smillert#*::ping = \5;
1389b39c5158Smillert#*::ping = {
1390b39c5158Smillert#  "\x{decaf}\x{decaf}\x{decaf}\x{decaf}" => do{my $o}
1391b39c5158Smillert#};
1392b39c5158Smillert#*::ping{HASH}->{"\x{decaf}\x{decaf}\x{decaf}\x{decaf}"} = *::ping{SCALAR};
1393b39c5158Smillert#%pong = %{*::ping{HASH}};
1394b39c5158SmillertEOT
1395b39c5158Smillert  local $Data::Dumper::Purity = 1;
1396b39c5158Smillert  local $Data::Dumper::Sortkeys;
1397b39c5158Smillert  $ping = 5;
1398b39c5158Smillert  %ping = (chr (0xDECAF) x 4  =>\$ping);
1399b39c5158Smillert  for $Data::Dumper::Sortkeys (0, 1) {
1400b39c5158Smillert    if($] >= 5.007) {
1401b39c5158Smillert      TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong']));
1402b39c5158Smillert      TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS;
1403b39c5158Smillert    } else {
1404b39c5158Smillert      SKIP_TEST "Incomplete support for UTF-8 in old perls";
1405b39c5158Smillert      SKIP_TEST "Incomplete support for UTF-8 in old perls";
1406b39c5158Smillert    }
1407b39c5158Smillert  }
1408b39c5158Smillert}
1409b39c5158Smillert
1410b39c5158Smillert# XS for quotekeys==0 was not being defensive enough against utf8 flagged
1411b39c5158Smillert# scalars
1412b39c5158Smillert
1413b39c5158Smillert{
1414b39c5158Smillert  $WANT = <<'EOT';
1415b39c5158Smillert#$VAR1 = {
1416b39c5158Smillert#  perl => 'rocks'
1417b39c5158Smillert#};
1418b39c5158SmillertEOT
1419b39c5158Smillert  local $Data::Dumper::Quotekeys = 0;
1420b39c5158Smillert  my $k = 'perl' . chr 256;
1421b39c5158Smillert  chop $k;
1422b39c5158Smillert  %foo = ($k => 'rocks');
1423b39c5158Smillert
1424b39c5158Smillert  TEST q(Data::Dumper->Dump([\\%foo])), "quotekeys == 0 for utf8 flagged ASCII";
1425b39c5158Smillert  TEST q(Data::Dumper->Dumpxs([\\%foo])),
1426b39c5158Smillert    "XS quotekeys == 0 for utf8 flagged ASCII" if $XS;
1427b39c5158Smillert}
1428b39c5158Smillert############# 358
1429b39c5158Smillert{
1430b39c5158Smillert  $WANT = <<'EOT';
1431b39c5158Smillert#$VAR1 = [
1432b39c5158Smillert#  undef,
1433b39c5158Smillert#  undef,
1434b39c5158Smillert#  1
1435b39c5158Smillert#];
1436b39c5158SmillertEOT
1437b39c5158Smillert    @foo = ();
1438b39c5158Smillert    $foo[2] = 1;
1439b39c5158Smillert    TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>';
1440b39c5158Smillert    TEST q(Data::Dumper->Dumpxs([\@foo])) if $XS;
1441b39c5158Smillert}
1442b39c5158Smillert
1443898184e3Ssthen############# 364
1444898184e3Ssthen# Make sure $obj->Dumpxs returns the right thing in list context. This was
1445898184e3Ssthen# broken by the initial attempt to fix [perl #74170].
1446898184e3Ssthen$WANT = <<'EOT';
1447898184e3Ssthen#$VAR1 = [];
1448898184e3SsthenEOT
1449898184e3SsthenTEST q(join " ", new Data::Dumper [[]],[] =>->Dumpxs),
1450898184e3Ssthen    '$obj->Dumpxs in list context'
1451898184e3Ssthen if $XS;
1452b39c5158Smillert
1453898184e3Ssthen############# 366
1454898184e3Ssthen{
1455898184e3Ssthen  $WANT = <<'EOT';
1456898184e3Ssthen#$VAR1 = [
1457898184e3Ssthen#  "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377"
1458898184e3Ssthen#];
1459898184e3SsthenEOT
1460898184e3Ssthen
1461898184e3Ssthen  $foo = [ join "", map chr, 0..255 ];
1462898184e3Ssthen  local $Data::Dumper::Useqq = 1;
1463898184e3Ssthen  TEST q(Dumper($foo)), 'All latin1 characters';
1464898184e3Ssthen  for (1..3) { print "not ok " . (++$TNUM) . " # TODO NYI\n" if $XS } # TEST q(Data::Dumper::DumperX($foo)) if $XS;
1465898184e3Ssthen}
1466898184e3Ssthen
1467898184e3Ssthen############# 372
1468898184e3Ssthen{
1469898184e3Ssthen  $WANT = <<'EOT';
1470898184e3Ssthen#$VAR1 = [
1471898184e3Ssthen#  "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\x{80}\x{81}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8d}\x{8e}\x{8f}\x{90}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9d}\x{9e}\x{9f}\x{a0}\x{a1}\x{a2}\x{a3}\x{a4}\x{a5}\x{a6}\x{a7}\x{a8}\x{a9}\x{aa}\x{ab}\x{ac}\x{ad}\x{ae}\x{af}\x{b0}\x{b1}\x{b2}\x{b3}\x{b4}\x{b5}\x{b6}\x{b7}\x{b8}\x{b9}\x{ba}\x{bb}\x{bc}\x{bd}\x{be}\x{bf}\x{c0}\x{c1}\x{c2}\x{c3}\x{c4}\x{c5}\x{c6}\x{c7}\x{c8}\x{c9}\x{ca}\x{cb}\x{cc}\x{cd}\x{ce}\x{cf}\x{d0}\x{d1}\x{d2}\x{d3}\x{d4}\x{d5}\x{d6}\x{d7}\x{d8}\x{d9}\x{da}\x{db}\x{dc}\x{dd}\x{de}\x{df}\x{e0}\x{e1}\x{e2}\x{e3}\x{e4}\x{e5}\x{e6}\x{e7}\x{e8}\x{e9}\x{ea}\x{eb}\x{ec}\x{ed}\x{ee}\x{ef}\x{f0}\x{f1}\x{f2}\x{f3}\x{f4}\x{f5}\x{f6}\x{f7}\x{f8}\x{f9}\x{fa}\x{fb}\x{fc}\x{fd}\x{fe}\x{ff}\x{20ac}"
1472898184e3Ssthen#];
1473898184e3SsthenEOT
1474898184e3Ssthen
1475898184e3Ssthen  $foo = [ join "", map chr, 0..255, 0x20ac ];
1476898184e3Ssthen  local $Data::Dumper::Useqq = 1;
1477898184e3Ssthen  if ($] < 5.007) {
1478898184e3Ssthen    print "not ok " . (++$TNUM) . " # TODO - fails under 5.6\n" for 1..3;
1479898184e3Ssthen  }
1480898184e3Ssthen  else {
1481898184e3Ssthen    TEST q(Dumper($foo)),
1482898184e3Ssthen	 'All latin1 characters with utf8 flag including a wide character';
1483898184e3Ssthen  }
1484898184e3Ssthen  for (1..3) { print "not ok " . (++$TNUM) . " # TODO NYI\n" if $XS } # TEST q(Data::Dumper::DumperX($foo)) if $XS;
1485898184e3Ssthen}
1486898184e3Ssthen
1487898184e3Ssthen############# 378
1488898184e3Ssthen{
1489898184e3Ssthen  # If XS cannot load, the pure-Perl version cannot deparse vstrings with
1490898184e3Ssthen  # underscores properly.  In 5.8.0, vstrings are just strings.
1491*91f110e0Safresh1  my $no_vstrings = <<'NOVSTRINGS';
1492898184e3Ssthen#$a = \'ABC';
1493898184e3Ssthen#$b = \'ABC';
1494898184e3Ssthen#$c = \'ABC';
1495898184e3Ssthen#$d = \'ABC';
1496*91f110e0Safresh1NOVSTRINGS
1497*91f110e0Safresh1  my $vstrings_corr = <<'VSTRINGS_CORRECT';
1498*91f110e0Safresh1#$a = \v65.66.67;
1499*91f110e0Safresh1#$b = \v65.66.067;
1500*91f110e0Safresh1#$c = \v65.66.6_7;
1501*91f110e0Safresh1#$d = \'ABC';
1502*91f110e0Safresh1VSTRINGS_CORRECT
1503*91f110e0Safresh1  $WANT = $] <= 5.0080001
1504*91f110e0Safresh1          ? $no_vstrings
1505*91f110e0Safresh1          : $vstrings_corr;
1506*91f110e0Safresh1
1507898184e3Ssthen  @::_v = (
1508898184e3Ssthen    \v65.66.67,
1509898184e3Ssthen    \($] < 5.007 ? v65.66.67 : eval 'v65.66.067'),
1510898184e3Ssthen    \v65.66.6_7,
1511898184e3Ssthen    \~v190.189.188
1512898184e3Ssthen  );
1513*91f110e0Safresh1  if ($] >= 5.010) {
1514898184e3Ssthen    TEST q(Data::Dumper->Dump(\@::_v, [qw(a b c d)])), 'vstrings';
1515898184e3Ssthen    TEST q(Data::Dumper->Dumpxs(\@::_v, [qw(a b c d)])), 'xs vstrings'
1516898184e3Ssthen      if $XS;
1517898184e3Ssthen  }
1518*91f110e0Safresh1  else { # Skip tests before 5.10. vstrings considered funny before
1519*91f110e0Safresh1    SKIP_TEST "vstrings considered funny before 5.10.0";
1520*91f110e0Safresh1    SKIP_TEST "vstrings considered funny before 5.10.0 (XS)"
1521*91f110e0Safresh1      if $XS;
1522*91f110e0Safresh1  }
1523*91f110e0Safresh1}
1524898184e3Ssthen
1525898184e3Ssthen############# 384
1526898184e3Ssthen{
1527898184e3Ssthen  # [perl #107372] blessed overloaded globs
1528898184e3Ssthen  $WANT = <<'EOW';
1529898184e3Ssthen#$VAR1 = bless( \*::finkle, 'overtest' );
1530898184e3SsthenEOW
1531898184e3Ssthen  {
1532898184e3Ssthen    package overtest;
1533898184e3Ssthen    use overload fallback=>1, q\""\=>sub{"oaoaa"};
1534898184e3Ssthen  }
1535898184e3Ssthen  TEST q(Data::Dumper->Dump([bless \*finkle, "overtest"])),
1536898184e3Ssthen    'blessed overloaded globs';
1537898184e3Ssthen  TEST q(Data::Dumper->Dumpxs([\*finkle])), 'blessed overloaded globs (xs)'
1538898184e3Ssthen    if $XS;
1539898184e3Ssthen}
1540