rdelaage
/
postgresql
mirror of https://git.postgresql.org/git/postgresql.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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:
Tom Lane 2018-04-04 11:28:33 -04:00
parent 3a5e0a91bb
commit 331b2369c0
6 changed files with 115 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/jsonb_plperl/Makefile
View File

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

30
contrib/jsonb_plperl/expected/jsonb_plperl.out
View File

@ -39,15 +39,30 @@ SELECT testSVToJsonb();
1
(1 row)
-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperl
TRANSFORM FOR TYPE jsonb
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));
$$;
SELECT testRegexpToJsonb();
ERROR: cannot transform this Perl type to jsonb
CONTEXT: PL/Perl function "testregexptojsonb"
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

30
contrib/jsonb_plperl/expected/jsonb_plperlu.out
View File

@ -39,15 +39,30 @@ SELECT testSVToJsonb();
1
(1 row)
-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperlu
TRANSFORM FOR TYPE jsonb
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));
$$;
SELECT testRegexpToJsonb();
ERROR: cannot transform this Perl type to jsonb
CONTEXT: PL/Perl function "testregexptojsonb"
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

78
contrib/jsonb_plperl/jsonb_plperl.c
View File

@ -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:
{
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:
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:
if (SvIOK(in))
{
IV ival = SvIV(in);
/*
* 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;
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_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. */

16
contrib/jsonb_plperl/sql/jsonb_plperl.sql
View File

@ -34,14 +34,27 @@ $$;
SELECT testSVToJsonb();
-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperl
TRANSFORM FOR TYPE jsonb
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));
$$;
SELECT testRegexpToJsonb();
SELECT testRegexpResultToJsonb();
CREATE FUNCTION roundtrip(val jsonb) RETURNS 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;

16
contrib/jsonb_plperl/sql/jsonb_plperlu.sql
View File

@ -34,14 +34,27 @@ $$;
SELECT testSVToJsonb();
-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperlu
TRANSFORM FOR TYPE jsonb
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));
$$;
SELECT testRegexpToJsonb();
SELECT testRegexpResultToJsonb();
CREATE FUNCTION roundtrip(val jsonb) RETURNS 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;