mirror of
https://github.com/postgres/postgres.git
synced 2025-06-17 17:02:08 +03:00
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
This commit is contained in:
@ -11,6 +11,8 @@ DATA = jsonb_plperlu--1.0.sql jsonb_plperl--1.0.sql
|
|||||||
|
|
||||||
REGRESS = jsonb_plperl jsonb_plperlu
|
REGRESS = jsonb_plperl jsonb_plperlu
|
||||||
|
|
||||||
|
SHLIB_LINK += $(filter -lm, $(LIBS))
|
||||||
|
|
||||||
ifdef USE_PGXS
|
ifdef USE_PGXS
|
||||||
PG_CONFIG = pg_config
|
PG_CONFIG = pg_config
|
||||||
PGXS := $(shell $(PG_CONFIG) --pgxs)
|
PGXS := $(shell $(PG_CONFIG) --pgxs)
|
||||||
|
@ -39,15 +39,30 @@ SELECT testSVToJsonb();
|
|||||||
1
|
1
|
||||||
(1 row)
|
(1 row)
|
||||||
|
|
||||||
|
-- unsupported (for now)
|
||||||
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
||||||
LANGUAGE plperl
|
LANGUAGE plperl
|
||||||
TRANSFORM FOR TYPE jsonb
|
TRANSFORM FOR TYPE jsonb
|
||||||
AS $$
|
AS $$
|
||||||
|
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));
|
return ('1' =~ m(0\t2));
|
||||||
$$;
|
$$;
|
||||||
SELECT testRegexpToJsonb();
|
SELECT testRegexpResultToJsonb();
|
||||||
ERROR: cannot transform this Perl type to jsonb
|
testregexpresulttojsonb
|
||||||
CONTEXT: PL/Perl function "testregexptojsonb"
|
-------------------------
|
||||||
|
0
|
||||||
|
(1 row)
|
||||||
|
|
||||||
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
||||||
LANGUAGE plperl
|
LANGUAGE plperl
|
||||||
TRANSFORM FOR TYPE jsonb
|
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": {"2": [3, 4, 5]}, "2": 3}
|
||||||
(1 row)
|
(1 row)
|
||||||
|
|
||||||
|
\set VERBOSITY terse \\ -- suppress cascade details
|
||||||
DROP EXTENSION plperl CASCADE;
|
DROP EXTENSION plperl CASCADE;
|
||||||
NOTICE: drop cascades to 6 other objects
|
NOTICE: drop cascades to 7 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)
|
|
||||||
|
@ -39,15 +39,30 @@ SELECT testSVToJsonb();
|
|||||||
1
|
1
|
||||||
(1 row)
|
(1 row)
|
||||||
|
|
||||||
|
-- unsupported (for now)
|
||||||
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
||||||
LANGUAGE plperlu
|
LANGUAGE plperlu
|
||||||
TRANSFORM FOR TYPE jsonb
|
TRANSFORM FOR TYPE jsonb
|
||||||
AS $$
|
AS $$
|
||||||
|
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));
|
return ('1' =~ m(0\t2));
|
||||||
$$;
|
$$;
|
||||||
SELECT testRegexpToJsonb();
|
SELECT testRegexpResultToJsonb();
|
||||||
ERROR: cannot transform this Perl type to jsonb
|
testregexpresulttojsonb
|
||||||
CONTEXT: PL/Perl function "testregexptojsonb"
|
-------------------------
|
||||||
|
0
|
||||||
|
(1 row)
|
||||||
|
|
||||||
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
||||||
LANGUAGE plperlu
|
LANGUAGE plperlu
|
||||||
TRANSFORM FOR TYPE jsonb
|
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": {"2": [3, 4, 5]}, "2": 3}
|
||||||
(1 row)
|
(1 row)
|
||||||
|
|
||||||
|
\set VERBOSITY terse \\ -- suppress cascade details
|
||||||
DROP EXTENSION plperlu CASCADE;
|
DROP EXTENSION plperlu CASCADE;
|
||||||
NOTICE: drop cascades to 6 other objects
|
NOTICE: drop cascades to 7 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)
|
|
||||||
|
@ -1,11 +1,14 @@
|
|||||||
#include "postgres.h"
|
#include "postgres.h"
|
||||||
|
|
||||||
|
#include <float.h>
|
||||||
|
#include <math.h>
|
||||||
|
|
||||||
|
/* Defined by Perl */
|
||||||
#undef _
|
#undef _
|
||||||
|
|
||||||
#include "fmgr.h"
|
#include "fmgr.h"
|
||||||
#include "plperl.h"
|
#include "plperl.h"
|
||||||
#include "plperl_helpers.h"
|
#include "plperl_helpers.h"
|
||||||
|
|
||||||
#include "utils/jsonb.h"
|
#include "utils/jsonb.h"
|
||||||
#include "utils/fmgrprotos.h"
|
#include "utils/fmgrprotos.h"
|
||||||
|
|
||||||
@ -188,46 +191,51 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
|
|||||||
case SVt_PVHV:
|
case SVt_PVHV:
|
||||||
return HV_to_JsonbValue((HV *) in, jsonb_state);
|
return HV_to_JsonbValue((HV *) in, jsonb_state);
|
||||||
|
|
||||||
case SVt_NV:
|
|
||||||
case SVt_IV:
|
|
||||||
{
|
|
||||||
char *str = sv2cstr(in);
|
|
||||||
|
|
||||||
/*
|
|
||||||
* Use case-insensitive comparison because infinity
|
|
||||||
* representation varies across Perl versions.
|
|
||||||
*/
|
|
||||||
if (pg_strcasecmp(str, "inf") == 0)
|
|
||||||
ereport(ERROR,
|
|
||||||
(errcode(ERRCODE_INVALID_PARAMETER_VALUE),
|
|
||||||
(errmsg("cannot convert infinite value to jsonb"))));
|
|
||||||
|
|
||||||
out.type = jbvNumeric;
|
|
||||||
out.val.numeric = DatumGetNumeric(DirectFunctionCall3(numeric_in,
|
|
||||||
CStringGetDatum(str), 0, -1));
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
|
|
||||||
case SVt_NULL:
|
case SVt_NULL:
|
||||||
out.type = jbvNull;
|
out.type = jbvNull;
|
||||||
break;
|
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:
|
default:
|
||||||
|
if (SvIOK(in))
|
||||||
|
{
|
||||||
|
IV ival = SvIV(in);
|
||||||
|
|
||||||
/*
|
out.type = jbvNumeric;
|
||||||
* XXX It might be nice if we could include the Perl type in the
|
out.val.numeric =
|
||||||
* error message.
|
DatumGetNumeric(DirectFunctionCall1(int8_numeric,
|
||||||
*/
|
Int64GetDatum((int64) ival)));
|
||||||
ereport(ERROR,
|
}
|
||||||
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
else if (SvNOK(in))
|
||||||
(errmsg("cannot transform this Perl type to jsonb"))));
|
{
|
||||||
return NULL;
|
double nval = SvNV(in);
|
||||||
|
|
||||||
|
if (isinf(nval))
|
||||||
|
ereport(ERROR,
|
||||||
|
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
||||||
|
(errmsg("cannot convert infinite value to jsonb"))));
|
||||||
|
|
||||||
|
out.type = jbvNumeric;
|
||||||
|
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;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push result into 'jsonb_state' unless it is a raw scalar. */
|
/* Push result into 'jsonb_state' unless it is a raw scalar. */
|
||||||
|
@ -34,14 +34,27 @@ $$;
|
|||||||
SELECT testSVToJsonb();
|
SELECT testSVToJsonb();
|
||||||
|
|
||||||
|
|
||||||
|
-- unsupported (for now)
|
||||||
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
||||||
LANGUAGE plperl
|
LANGUAGE plperl
|
||||||
TRANSFORM FOR TYPE jsonb
|
TRANSFORM FOR TYPE jsonb
|
||||||
AS $$
|
AS $$
|
||||||
|
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));
|
return ('1' =~ m(0\t2));
|
||||||
$$;
|
$$;
|
||||||
|
|
||||||
SELECT testRegexpToJsonb();
|
SELECT testRegexpResultToJsonb();
|
||||||
|
|
||||||
|
|
||||||
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
||||||
@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
|
|||||||
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
|
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
|
||||||
|
|
||||||
|
|
||||||
|
\set VERBOSITY terse \\ -- suppress cascade details
|
||||||
DROP EXTENSION plperl CASCADE;
|
DROP EXTENSION plperl CASCADE;
|
||||||
|
@ -34,14 +34,27 @@ $$;
|
|||||||
SELECT testSVToJsonb();
|
SELECT testSVToJsonb();
|
||||||
|
|
||||||
|
|
||||||
|
-- unsupported (for now)
|
||||||
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
|
||||||
LANGUAGE plperlu
|
LANGUAGE plperlu
|
||||||
TRANSFORM FOR TYPE jsonb
|
TRANSFORM FOR TYPE jsonb
|
||||||
AS $$
|
AS $$
|
||||||
|
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));
|
return ('1' =~ m(0\t2));
|
||||||
$$;
|
$$;
|
||||||
|
|
||||||
SELECT testRegexpToJsonb();
|
SELECT testRegexpResultToJsonb();
|
||||||
|
|
||||||
|
|
||||||
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
|
||||||
@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
|
|||||||
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
|
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
|
||||||
|
|
||||||
|
|
||||||
|
\set VERBOSITY terse \\ -- suppress cascade details
|
||||||
DROP EXTENSION plperlu CASCADE;
|
DROP EXTENSION plperlu CASCADE;
|
||||||
|
Reference in New Issue
Block a user