diff --git a/c/jsonfmt.c b/c/jsonfmt.c index 6276d05..a46b29a 100644 --- a/c/jsonfmt.c +++ b/c/jsonfmt.c @@ -106,8 +106,7 @@ static void fujson_fmt_int(pTHX_ fustr *out, SV *val) { } if (uv > 0) *(--r) = '0' + (uv % 10); if (neg) *(--r) = '-'; - uv = 31 - (r - buf); - fustr_write(out, r, uv); + fustr_write(out, r, 31 - (r - buf)); } static void fujson_fmt_av(pTHX_ fustr *out, AV *av) { @@ -139,6 +138,35 @@ static void fujson_fmt_hv(pTHX_ fustr *out, HV *hv) { fustr_write(out, "}", 1); } +static void fujson_fmt_obj(pTHX_ fustr *out, SV *rv, SV *obj) { + dSP; + + GV *method = gv_fetchmethod_autoload(SvSTASH(obj), "TO_JSON", 0); + if (!method) croak("unable to format '%s' object as JSON", HvNAME(SvSTASH(obj))); + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(rv); + + PUTBACK; + call_sv((SV *)GvCV(method), G_SCALAR); + SPAGAIN; + + /* JSON::XS describes this error as "surprisingly common"... I'd be + * surprised indeed if it happens at all, but I suppose it can't hurt to + * copy their check; this sounds like be a pain to debug otherwise. */ + if (SvROK(TOPs) && SvRV(TOPs) == obj) + croak("%s::TO_JSON method returned same object as was passed instead of a new one", HvNAME(SvSTASH(obj))); + + obj = POPs; + PUTBACK; + fujson_fmt(aTHX_ out, obj); + + FREETMPS; + LEAVE; +} static void fujson_fmt(pTHX_ fustr *out, SV *val) { SvGETMAGIC(val); @@ -153,6 +181,8 @@ static void fujson_fmt(pTHX_ fustr *out, SV *val) { } else if (SvNOKp(val)) { /* Must check before IOKp, because integer conversion might have been lossy */ NV nv = SvNV_nomg(val); if (isinfnan(nv)) croak("unable to format floating point NaN or Inf as JSON"); + /* XXX: Cpanel::JSON::XS appears to always append a ".0" for round numbers, other modules do not. */ + /* XXX#2: This doesn't support quadmath. Makefile.PL checks for that */ fustr_reserve(out, NV_DIG+1); Gconvert(nv, NV_DIG, 0, out->cur); out->cur += strlen(out->cur); @@ -161,7 +191,7 @@ static void fujson_fmt(pTHX_ fustr *out, SV *val) { } else if (SvROK(val)) { SV *rv = SvRV(val); SvGETMAGIC(rv); - if (UNLIKELY(SvOBJECT(rv))) { /* TODO: Check for TO_JSON */ } + if (UNLIKELY(SvOBJECT(rv))) fujson_fmt_obj(aTHX_ out, val, rv); else if (SvTYPE(rv) == SVt_PVHV) fujson_fmt_hv(aTHX_ out, (HV *)rv); else if (SvTYPE(rv) == SVt_PVAV) fujson_fmt_av(aTHX_ out, (AV *)rv); else croak("unable to format reference '%s' as JSON", SvPV_nolen(val)); diff --git a/t/json_format.t b/t/json_format.t index f525572..8a6f014 100644 --- a/t/json_format.t +++ b/t/json_format.t @@ -5,19 +5,24 @@ use Tie::Array; use Tie::Hash; use FU::Util 'json_format'; -# TODO: gab some more tests from other JSON libs -# TODO: Test invalid utf8 + +sub MyToJSON::TO_JSON { [scalar @_, ref $_[0], ${$_[0]}] } +sub MyToJSONSelf::TO_JSON { $_[0] } my @tests = ( undef, 'null', true, 'true', false, 'false', - 0, '0', - 1, '1', - -1, '-1', - -9223372036854775808, '-9223372036854775808', - 9223372036854775807, '9223372036854775807', - 18446744073709551615, '18446744073709551615', + (map +($_, $_), + -1000..1000, + 12345, 123456, 1234567, + 98765, 987654, 9876543, + -12345, -123456, -1234567, + -98765, -987654, -9876543, + -9223372036854775808, + 9223372036854775807, + 18446744073709551615, + ), 0.1, '0.1', 0.000123, '0.000123', -1e100, '-1e+100', @@ -42,6 +47,9 @@ my @tests = ( 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":[]}', + do { my $o = [true]; bless \$o, 'MyToJSON' }, '[1,"MyToJSON",[true]]', + do { my $x = [true]; my $o = [bless \$x, 'MyToJSON']; bless \$o, 'MyToJSON' }, '[1,"MyToJSON",[[1,"MyToJSON",[true]]]]', + # from http://e-choroba.eu/18-yapc $$, $$, ''.$$, '"'.$$.'"', @@ -56,6 +64,8 @@ my @errors = ( '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/, + do { my $o = {}; bless $o, 'FU::Whatever' }, qr/unable to format 'FU::Whatever' object as JSON/, + do { my $o = {}; bless $o, 'MyToJSONSelf' }, qr/MyToJSONSelf::TO_JSON method returned same object as was passed instead of a new one/, ); plan tests => @tests*2 + @errors/2 + 6;