8ef2a724d1
Going to need a way to pass arguments into the XS function anyway, so might as well do the entire arg parsing step in XS while we're at it. Provides a significant speedup for tiny inputs as well, but I don't find that too interesting.
106 lines
2.8 KiB
Perl
106 lines
2.8 KiB
Perl
use v5.36;
|
|
use builtin 'true', 'false';
|
|
use Test::More;
|
|
use Tie::Array;
|
|
use Tie::Hash;
|
|
use FU::Util 'json_format';
|
|
|
|
# TODO: gab some more tests from other JSON libs
|
|
# TODO: Test invalid utf8
|
|
|
|
my @tests = (
|
|
undef, 'null',
|
|
true, 'true',
|
|
false, 'false',
|
|
0, '0',
|
|
1, '1',
|
|
-1, '-1',
|
|
-9223372036854775808, '-9223372036854775808',
|
|
9223372036854775807, '9223372036854775807',
|
|
18446744073709551615, '18446744073709551615',
|
|
0.1, '0.1',
|
|
0.000123, '0.000123',
|
|
-1e100, '-1e+100',
|
|
|
|
do { use utf8; (
|
|
"\x01é\r\n\x1f💩", '"\u0001é\r\n\u001f💩"',
|
|
)},
|
|
|
|
do { use bytes; (
|
|
"\x011\r\n\x8c", "\"\\u00011\\r\\n\x8c\"",
|
|
"\xff\xff", "\"\xff\xff\"",
|
|
"\x{1f4a9}", do { use utf8; '"💩"' },
|
|
)},
|
|
|
|
[], '[]',
|
|
[0,1], '[0,1]',
|
|
[true,'hi',-0.123, [undef]], '[true,"hi",-0.123,[null]]',
|
|
do { tie my @a, 'Tie::StdArray'; @a = (1,2); \@a }, '[1,2]',
|
|
|
|
{}, '{}',
|
|
{'a',1}, '{"a":1}',
|
|
do { tie my %h, 'Tie::StdHash'; %h = ('a',1); \%h }, '{"a":1}',
|
|
do { tie my %h, 'MyOrderedHash', one => 1, two => undef, three => []; \%h }, '{"one":1,"two":null,"three":[]}',
|
|
|
|
# from http://e-choroba.eu/18-yapc
|
|
$$, $$,
|
|
''.$$, '"'.$$.'"',
|
|
do { my $x = 12; utf8::decode($x); $x }, '"12"',
|
|
do { no warnings 'numeric'; my $x = '19a'; $x += 0; $x }, '19',
|
|
1844674407370955161 / 10, '1.84467440737096e+17',
|
|
);
|
|
|
|
my @errors = (
|
|
\1, qr/unable to format reference/,
|
|
*STDOUT, qr/unable to format unknown value/,
|
|
'NaN'+0, qr/unable to format floating point NaN or Inf as JSON/,
|
|
'Inf'+0, qr/unable to format floating point NaN or Inf as JSON/,
|
|
do { no warnings 'portable'; "\x{ffffffff}" }, qr/invalid codepoint encountered in string/,
|
|
);
|
|
|
|
plan tests => @tests*2 + @errors/2 + 6;
|
|
|
|
for my($in, $exp) (@tests) {
|
|
my $out = json_format $in;
|
|
is $out, $exp;
|
|
ok utf8::is_utf8($out);
|
|
|
|
$out = json_format $in, utf8 => 1;
|
|
utf8::encode(my $uexp = $exp);
|
|
is $out, $uexp;
|
|
ok !utf8::is_utf8($out);
|
|
}
|
|
|
|
for my ($in, $exp) (@errors) {
|
|
eval { json_format $in };
|
|
like $@, $exp;
|
|
}
|
|
|
|
|
|
|
|
# http://e-choroba.eu/18-yapc slide 6
|
|
|
|
tie my $incs, 'MyIncrementer', 'Xa';
|
|
is json_format($incs), '"Xa"';
|
|
is json_format($incs), '"Xb"';
|
|
is json_format($incs), '"Xc"';
|
|
|
|
tie my $incu, 'MyIncrementer', 4;
|
|
is json_format($incu), 4;
|
|
is json_format($incu), 5;
|
|
is json_format($incu), 6;
|
|
|
|
package MyIncrementer;
|
|
use Tie::Scalar;
|
|
use parent -norequire => 'Tie::StdScalar';
|
|
sub TIESCALAR { my ($class, $val) = @_; bless \$val, $class }
|
|
sub FETCH { my $s = shift; $$s++ }
|
|
|
|
|
|
package MyOrderedHash;
|
|
sub TIEHASH { shift; bless [ [ map $_[$_*2], 0..$#_/2 ], +{@_}, 0 ], __PACKAGE__ };
|
|
sub FETCH { $_[0][1]{$_[1]} }
|
|
sub EXISTS { exists $_[0][1]{$_[1]} }
|
|
sub FIRSTKEY { $_[0][2] = 0; &NEXTKEY }
|
|
sub NEXTKEY { $_[0][0][ $_[0][2]++ ] }
|
|
sub SCALAR { scalar $_[0][0]->@* }
|