jsonfmt: Add TO_JSON convert_blessed support

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));

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;