1 #-------------------------------------------------------------------------------
2 # Generates perl unit tests from the toml/json files in BurntSush/toml-test
3 # without having to add special casing to TOML::Tiny to conform to their
4 # annotated JSON format.
5 #-------------------------------------------------------------------------------
8 no warnings 'experimental';
14 # We want to read unicde as characters from toml-test source files. That makes
15 # things simpler for us when we parse them and generate perl source in the
16 # generated test file.
17 binmode STDIN, ':encoding(UTF-8)';
18 binmode STDOUT, ':encoding(UTF-8)';
21 open my $fh, '<', $_[0] or die $!;
26 # Removes type annotations from BurntSushi/toml-test JSON files and returns the
27 # cleaned up data structure to which the associated TOML file should be parsed.
29 state $json = JSON::PP->new->utf8(1);
30 my $annotated = $json->decode(slurp(shift));
31 my $cleanish = deannotate($annotated);
33 local $Data::Dumper::Varname = 'expected';
34 local $Data::Dumper::Deparse = 1;
35 return Dumper($cleanish);
38 # Recursively deannotates and inflates values from toml-test JSON data
39 # structures into a format more in line with TOML::Tiny's parser outout. For
40 # integer and float values, a Test2::Tools::Compare validator is generated to
41 # compare using Math::Big(Int|Float)->beq, since TOML's float and int types are
42 # 64 bits. Datetimes are converted to a common, normalized string format.
48 if (exists $data->{type} && exists $data->{value} && keys(%$data) == 2) {
50 return $data->{value} eq 'true' ? 1 : 0 when /bool/;
51 return [ map{ deannotate($_) } @{$data->{value}} ] when /array/;
55 use Test2::Tools::Compare qw(validator);
58 use DateTime::Format::RFC3339;
59 my \$exp = DateTime::Format::RFC3339->parse_datetime("$data->{value}");
60 my \$got = DateTime::Format::RFC3339->parse_datetime(\$_);
61 \$exp->set_time_zone('UTC');
62 \$got->set_time_zone('UTC');
63 return DateTime->compare(\$got, \$exp) == 0;
67 my $result = eval $src;
75 use Test2::Tools::Compare qw(validator);
78 Math::BigInt->new("$data->{value}")->beq(\$_);
82 my $result = eval $src;
90 use Test2::Tools::Compare qw(validator);
92 require Math::BigFloat;
93 Math::BigFloat->new("$data->{value}")->beq(\$_);
97 my $result = eval $src;
103 default{ return $data->{value} }
108 $object{$_} = deannotate($data->{$_}) for keys %$data;
113 return [ map{ deannotate($_) } @$data ];
122 sub build_pospath_test_files{
126 $src = "$src/tests/valid";
127 $dest = "$dest/t/toml-test/valid";
129 print "Generating positive path tests from $src\n";
132 system('mkdir', '-p', $dest) == 0 || die $?;
138 opendir my $dh, $src or die $!;
140 while (my $file = readdir $dh) {
141 my $path = "$src/$file";
142 my ($test, $ext) = $file =~ /^(.*)\.([^\.]+)$/;
146 $TOML{$test} = $path when /toml/;
147 $JSON{$test} = $path when /json/;
153 for (sort keys %TOML) {
154 my $data = deturd_json($JSON{$_});
156 my $toml = slurp($TOML{$_});
157 $toml =~ s/\\/\\\\/g;
159 open my $fh, '>', "$dest/$_.t" or die $!;
161 print $fh qq{# File automatically generated from BurntSushi/toml-test
166 use DateTime::Format::RFC3339;
171 binmode STDIN, ':encoding(UTF-8)';
172 binmode STDOUT, ':encoding(UTF-8)';
176 my \$actual = from_toml(q{$toml});
178 is(\$actual, \$expected1, '$_ - from_toml') or do{
180 diag Dumper(\$expected1);
183 diag Dumper(\$actual);
186 is(eval{ from_toml(to_toml(\$actual)) }, \$actual, '$_ - to_toml') or do{
188 diag Dumper(\$actual);
191 diag to_toml(\$actual);
193 diag 'REPARSED OUTPUT:';
194 diag Dumper(from_toml(to_toml(\$actual)));
203 sub build_negpath_test_files{
207 $src = "$src/tests/invalid";
208 $dest = "$dest/t/toml-test/invalid";
210 print "Generating negative path tests from $src\n";
213 system('mkdir', '-p', $dest) == 0 || die $?;
218 opendir my $dh, $src or die $!;
220 while (my $file = readdir $dh) {
221 my $path = "$src/$file";
222 my ($test, $ext) = $file =~ /^(.*)\.([^\.]+)$/;
224 if ($ext && $ext eq 'toml') {
225 $TOML{$test} = $path;
231 for (sort keys %TOML) {
232 my $toml = slurp($TOML{$_});
233 $toml =~ s/\\/\\\\/g;
235 open my $fh, '>', "$dest/$_.t" or die $!;
237 print $fh qq{# File automatically generated from BurntSushi/toml-test
242 binmode STDIN, ':encoding(UTF-8)';
243 binmode STDOUT, ':encoding(UTF-8)';
248 }, strict_arrays => 1);
249 }), 'strict_mode dies on $_';
257 my $usage = "usage: build-tests \$toml-test-repo-path \$toml-tiny-repo-path\n";
258 my $toml_test_path = shift @ARGV || die $usage;
259 my $toml_tiny_path = shift @ARGV || die $usage;
261 -d $toml_test_path || die "invalid path to BurntSush/toml-test: $toml_test_path\n";
262 -d "$toml_test_path/tests" || die "invalid path to BurntSush/toml-test: $toml_test_path\n";
263 -d $toml_tiny_path || die "invalid path to TOML::Tiny repo: $toml_tiny_path\n";
264 -d "$toml_tiny_path/t" || die "invalid path to TOML::Tiny repo: $toml_tiny_path\n";
266 build_pospath_test_files($toml_test_path, $toml_tiny_path);
267 build_negpath_test_files($toml_test_path, $toml_tiny_path);