1#!perl
2
3use strict;
4use warnings;
5
6use Fatal qw<open close>;
7use Text::Balanced qw<extract_bracketed>;
8
9open my $hash_t,       '<', 't/20-hash.t';
10open my $array_t,      '>', 't/30-array.t';
11open my $array_fast_t, '>', 't/31-array-fast.t';
12
13sub num {
14 my ($char) = $_[0] =~ /['"]?([a-z])['"]?/;
15 return ord($char) - ord('a')
16}
17
18sub hash2array {
19 my ($h) = @_;
20 return $h unless $h and ref $h eq 'HASH';
21 my @array;
22 for (keys %$h) {
23  $array[num($_)] = hash2array($h->{$_});
24 }
25 return \@array;
26}
27
28sub dump_array {
29 my ($a) = @_;
30
31 return 'undef' unless defined $a;
32
33 if (ref $a) {
34  die "Invalid argument" unless ref $a eq 'ARRAY';
35  return '[ ' . join(', ', map dump_array($_), @$a) . ' ]';
36 } else {
37  $a = "'\Q$a\E'" if $a !~ /^\s*\d/;
38  return $a;
39 }
40}
41
42sub extract ($$) {
43 extract_bracketed $_[0], $_[1],  qr/.*?(?<![\\@%])(?:\\\\)*(?=$_[1])/
44}
45
46sub convert_testcase ($$) {
47 local $_ = $_[0];
48 my $fast = $_[1];
49
50 s!(\ba\b)?(\s*)HASH\b!($1 ? 'an': '') . "$2ARRAY"!eg;
51 s{
52  [\{\[]\s*(['"]?[a-z]['"]?(?:\s*,\s*['"]?[a-z]['"]?)*)\s*[\}\]]
53 }{
54  '[' . join(', ', map { my $n = num($_); $fast ? $n : "\$N[$n]" }
55                    split /\s*,\s*/, $1) . ']'
56 }gex;
57 s!%(\{?)\$!\@$1\$!g;
58
59 my $buf;
60 my $suffix = $_;
61 my ($bracket, $prefix);
62 while (do { ($bracket, $suffix, $prefix) = extract($suffix, '{'); $bracket }) {
63  my $array = dump_array(hash2array(eval $bracket));
64  $buf .= $prefix . $array;
65 }
66 $buf .= $suffix;
67 $buf =~ s/\s+/ /g;
68 $buf =~ s/\s+$//;
69
70 return "$buf\n";
71}
72
73my $in_data;
74while (<$hash_t>) {
75 if (/^__DATA__$/) {
76  $in_data = 1;
77  print $array_t      $_;
78  print $array_fast_t $_;
79 } elsif (!$in_data) {
80  s{'%'}{'\@'};
81  print $array_t      $_;
82  print $array_fast_t $_;
83 } else {
84  print $array_t      convert_testcase($_, 0);
85  print $array_fast_t convert_testcase($_, 1);
86 }
87}
88
89close $hash_t;
90close $array_t;
91close $array_fast_t;
92
93open my $hash_kv_t,  '<', 't/22-hash-kv.t';
94open my $array_kv_t, '>', 't/32-array-kv.t';
95
96$in_data = 0;
97while (<$hash_kv_t>) {
98 if (/^__DATA__$/) {
99  $in_data = 1;
100 } elsif (!$in_data) {
101  s{'%'}{'\@'};
102  if (/\bplan\s*[\s\(]\s*tests\b/) {
103   s/\s*;?\s*$//;
104   s/^(\s*)//;
105   $_ = qq($1if ("\$]" >= 5.011) { $_ } else { plan skip_all => 'perl 5.11 required for keys/values \@array' }\n);
106  }
107 } else {
108  $_ = convert_testcase($_, 1);
109 }
110 print $array_kv_t $_;
111}
112