Fix platform and Perl-version dependencies in new jsonb_plperl code.

Testing SvTYPE() directly is more fraught with problems than one might
think, because depending on context Perl might be storing a scalar value
in one of several forms, eg both numeric and string values.  This resulted
in Perl-version-dependent buildfarm test failures.  Instead use the SvTYPE
test only to distinguish non-scalar cases (AV, HV, NULL).  Disambiguate
scalars by testing SvIOK, SvNOK, then SvPOK.  This creates a preference
order for how we will resolve cases where the value is available in more
than one form, which seems fine to me.

Furthermore, because we're now dealing directly with a "double" value
in the SvNOK case, we can get rid of an inadequate and unportable
string-comparison test for infinities, and use isinf() instead.
(We do need some additional #include and "-lm" infrastructure to use
that in a contrib module, per prior experiences.)

In passing, prevent the regression test results from depending on DROP
CASCADE order; I've not seen that malfunction, but it's trouble waiting
to happen.

Discussion: https://postgr.es/m/E1f3MMJ-0006bf-B0@gemulon.postgresql.org

diff --git a/contrib/jsonb_plperl/Makefile b/contrib/jsonb_plperl/Makefile
index b9fe943197269dbfa40178ba17db9acd5ff47b42..eb6d1deb7df62e71bd60357940c063e50807b54e 100644 (file)
--- a/contrib/jsonb_plperl/Makefile
+++ b/contrib/jsonb_plperl/Makefile
@@ -11,6 +11,8 @@ DATA = jsonb_plperlu--1.0.sql jsonb_plperl--1.0.sql
 
 REGRESS = jsonb_plperl jsonb_plperlu
 
+SHLIB_LINK += $(filter -lm, $(LIBS))
+
 ifdef USE_PGXS
 PG_CONFIG = pg_config
 PGXS := $(shell $(PG_CONFIG) --pgxs)

diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out
index 5bb5677f711a3bc22d858ef0791a00a164499c22..79d53e5e50fb11eff7c612252d32a9cac92c4a8c 100644 (file)
--- a/contrib/jsonb_plperl/expected/jsonb_plperl.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -39,15 +39,30 @@ SELECT testSVToJsonb();
  1
 (1 row)
 
+-- unsupported (for now)
 CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
 LANGUAGE plperl
 TRANSFORM FOR TYPE jsonb
 AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
 $$;
 SELECT testRegexpToJsonb();
 ERROR:  cannot transform this Perl type to jsonb
 CONTEXT:  PL/Perl function "testregexptojsonb"
+-- this revealed a bug in the original implementation
+CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+SELECT testRegexpResultToJsonb();
+ testregexpresulttojsonb 
+-------------------------
+ 0
+(1 row)
+
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperl
 TRANSFORM FOR TYPE jsonb
@@ -201,11 +216,6 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
  {"1": {"2": [3, 4, 5]}, "2": 3}
 (1 row)
 
+\set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperl CASCADE;
-NOTICE:  drop cascades to 6 other objects
-DETAIL:  drop cascades to extension jsonb_plperl
-drop cascades to function testhvtojsonb()
-drop cascades to function testavtojsonb()
-drop cascades to function testsvtojsonb()
-drop cascades to function testregexptojsonb()
-drop cascades to function roundtrip(jsonb)
+NOTICE:  drop cascades to 7 other objects

diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu.out b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
index 9527e9ee9d4fe7e6c2117e270290fe7f4fba73af..e842a03396c17af2a05a8cc747739be6ae9b9435 100644 (file)
--- a/contrib/jsonb_plperl/expected/jsonb_plperlu.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
@@ -39,15 +39,30 @@ SELECT testSVToJsonb();
  1
 (1 row)
 
+-- unsupported (for now)
 CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
 LANGUAGE plperlu
 TRANSFORM FOR TYPE jsonb
 AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
 $$;
 SELECT testRegexpToJsonb();
 ERROR:  cannot transform this Perl type to jsonb
 CONTEXT:  PL/Perl function "testregexptojsonb"
+-- this revealed a bug in the original implementation
+CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+SELECT testRegexpResultToJsonb();
+ testregexpresulttojsonb 
+-------------------------
+ 0
+(1 row)
+
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperlu
 TRANSFORM FOR TYPE jsonb
@@ -201,11 +216,6 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
  {"1": {"2": [3, 4, 5]}, "2": 3}
 (1 row)
 
+\set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperlu CASCADE;
-NOTICE:  drop cascades to 6 other objects
-DETAIL:  drop cascades to extension jsonb_plperlu
-drop cascades to function testhvtojsonb()
-drop cascades to function testavtojsonb()
-drop cascades to function testsvtojsonb()
-drop cascades to function testregexptojsonb()
-drop cascades to function roundtrip(jsonb)
+NOTICE:  drop cascades to 7 other objects

diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index ad9e65516f1818469f3b70f7e09efc1bd81854a6..837bae2ab500dff4f8104cd12044330064cf51e6 100644 (file)
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -1,11 +1,14 @@
 #include "postgres.h"
 
+#include <float.h>
+#include <math.h>
+
+/* Defined by Perl */
 #undef _
 
 #include "fmgr.h"
 #include "plperl.h"
 #include "plperl_helpers.h"
-
 #include "utils/jsonb.h"
 #include "utils/fmgrprotos.h"
 
@@ -188,46 +191,51 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
        case SVt_PVHV:
            return HV_to_JsonbValue((HV *) in, jsonb_state);
 
-       case SVt_NV:
-       case SVt_IV:
+       case SVt_NULL:
+           out.type = jbvNull;
+           break;
+
+       default:
+           if (SvIOK(in))
            {
-               char       *str = sv2cstr(in);
+               IV          ival = SvIV(in);
 
-               /*
-                * Use case-insensitive comparison because infinity
-                * representation varies across Perl versions.
-                */
-               if (pg_strcasecmp(str, "inf") == 0)
+               out.type = jbvNumeric;
+               out.val.numeric =
+                   DatumGetNumeric(DirectFunctionCall1(int8_numeric,
+                                                       Int64GetDatum((int64) ival)));
+           }
+           else if (SvNOK(in))
+           {
+               double      nval = SvNV(in);
+
+               if (isinf(nval))
                    ereport(ERROR,
-                           (errcode(ERRCODE_INVALID_PARAMETER_VALUE),
+                           (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
                             (errmsg("cannot convert infinite value to jsonb"))));
 
                out.type = jbvNumeric;
-               out.val.numeric = DatumGetNumeric(DirectFunctionCall3(numeric_in,
-                                                                     CStringGetDatum(str), 0, -1));
+               out.val.numeric =
+                   DatumGetNumeric(DirectFunctionCall1(float8_numeric,
+                                                       Float8GetDatum(nval)));
+           }
+           else if (SvPOK(in))
+           {
+               out.type = jbvString;
+               out.val.string.val = sv2cstr(in);
+               out.val.string.len = strlen(out.val.string.val);
+           }
+           else
+           {
+               /*
+                * XXX It might be nice if we could include the Perl type in
+                * the error message.
+                */
+               ereport(ERROR,
+                       (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                        (errmsg("cannot transform this Perl type to jsonb"))));
+               return NULL;
            }
-           break;
-
-       case SVt_NULL:
-           out.type = jbvNull;
-           break;
-
-       case SVt_PV:            /* string */
-           out.type = jbvString;
-           out.val.string.val = sv2cstr(in);
-           out.val.string.len = strlen(out.val.string.val);
-           break;
-
-       default:
-
-           /*
-            * XXX It might be nice if we could include the Perl type in the
-            * error message.
-            */
-           ereport(ERROR,
-                   (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
-                    (errmsg("cannot transform this Perl type to jsonb"))));
-           return NULL;
    }
 
    /* Push result into 'jsonb_state' unless it is a raw scalar. */

diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl.sql b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
index 2c779fcd08744530a938e8679b046fa47d65aaff..9993132ef0d0a75e5a1e0248cef0aa3bc710a741 100644 (file)
--- a/contrib/jsonb_plperl/sql/jsonb_plperl.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
@@ -34,16 +34,29 @@ $$;
 SELECT testSVToJsonb();
 
 
+-- unsupported (for now)
 CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
 LANGUAGE plperl
 TRANSFORM FOR TYPE jsonb
 AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
 $$;
 
 SELECT testRegexpToJsonb();
 
 
+-- this revealed a bug in the original implementation
+CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+
+SELECT testRegexpResultToJsonb();
+
+
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperl
 TRANSFORM FOR TYPE jsonb
@@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
 SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
 
 
+\set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperl CASCADE;

diff --git a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
index e2acffae36e07a17cf718f1e5990c40a61aa7c88..ab7d2e76e87db6d5d4ac86ce8bebbf0aa381fd57 100644 (file)
--- a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
@@ -34,16 +34,29 @@ $$;
 SELECT testSVToJsonb();
 
 
+-- unsupported (for now)
 CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
 LANGUAGE plperlu
 TRANSFORM FOR TYPE jsonb
 AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
 $$;
 
 SELECT testRegexpToJsonb();
 
 
+-- this revealed a bug in the original implementation
+CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+
+SELECT testRegexpResultToJsonb();
+
+
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperlu
 TRANSFORM FOR TYPE jsonb
@@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
 SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
 
 
+\set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperlu CASCADE;