Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit331b236

Browse files
committed
Fix platform and Perl-version dependencies in new jsonb_plperl code.
Testing SvTYPE() directly is more fraught with problems than one mightthink, because depending on context Perl might be storing a scalar valuein one of several forms, eg both numeric and string values. This resultedin Perl-version-dependent buildfarm test failures. Instead use the SvTYPEtest only to distinguish non-scalar cases (AV, HV, NULL). Disambiguatescalars by testing SvIOK, SvNOK, then SvPOK. This creates a preferenceorder for how we will resolve cases where the value is available in morethan one form, which seems fine to me.Furthermore, because we're now dealing directly with a "double" valuein the SvNOK case, we can get rid of an inadequate and unportablestring-comparison test for infinities, and use isinf() instead.(We do need some additional #include and "-lm" infrastructure to usethat in a contrib module, per prior experiences.)In passing, prevent the regression test results from depending on DROPCASCADE order; I've not seen that malfunction, but it's trouble waitingto happen.Discussion:https://postgr.es/m/E1f3MMJ-0006bf-B0@gemulon.postgresql.org
1 parent3a5e0a9 commit331b236

File tree

6 files changed

+110
-52
lines changed

6 files changed

+110
-52
lines changed

‎contrib/jsonb_plperl/Makefile

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@ DATA = jsonb_plperlu--1.0.sql jsonb_plperl--1.0.sql
1111

1212
REGRESS = jsonb_plperl jsonb_plperlu
1313

14+
SHLIB_LINK +=$(filter -lm,$(LIBS))
15+
1416
ifdefUSE_PGXS
1517
PG_CONFIG = pg_config
1618
PGXS :=$(shell$(PG_CONFIG) --pgxs)

‎contrib/jsonb_plperl/expected/jsonb_plperl.out

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -39,15 +39,30 @@ SELECT testSVToJsonb();
3939
1
4040
(1 row)
4141

42+
-- unsupported (for now)
4243
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
4344
LANGUAGE plperl
4445
TRANSFORM FOR TYPE jsonb
4546
AS $$
46-
return ('1' =~ m(0\t2));
47+
my $a = qr/foo/;
48+
return ($a);
4749
$$;
4850
SELECT testRegexpToJsonb();
4951
ERROR: cannot transform this Perl type to jsonb
5052
CONTEXT: PL/Perl function "testregexptojsonb"
53+
-- this revealed a bug in the original implementation
54+
CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
55+
LANGUAGE plperl
56+
TRANSFORM FOR TYPE jsonb
57+
AS $$
58+
return ('1' =~ m(0\t2));
59+
$$;
60+
SELECT testRegexpResultToJsonb();
61+
testregexpresulttojsonb
62+
-------------------------
63+
0
64+
(1 row)
65+
5166
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
5267
LANGUAGE plperl
5368
TRANSFORM FOR TYPE jsonb
@@ -201,11 +216,6 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
201216
{"1": {"2": [3, 4, 5]}, "2": 3}
202217
(1 row)
203218

219+
\set VERBOSITY terse \\ -- suppress cascade details
204220
DROP EXTENSION plperl CASCADE;
205-
NOTICE: drop cascades to 6 other objects
206-
DETAIL: drop cascades to extension jsonb_plperl
207-
drop cascades to function testhvtojsonb()
208-
drop cascades to function testavtojsonb()
209-
drop cascades to function testsvtojsonb()
210-
drop cascades to function testregexptojsonb()
211-
drop cascades to function roundtrip(jsonb)
221+
NOTICE: drop cascades to 7 other objects

‎contrib/jsonb_plperl/expected/jsonb_plperlu.out

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -39,15 +39,30 @@ SELECT testSVToJsonb();
3939
1
4040
(1 row)
4141

42+
-- unsupported (for now)
4243
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
4344
LANGUAGE plperlu
4445
TRANSFORM FOR TYPE jsonb
4546
AS $$
46-
return ('1' =~ m(0\t2));
47+
my $a = qr/foo/;
48+
return ($a);
4749
$$;
4850
SELECT testRegexpToJsonb();
4951
ERROR: cannot transform this Perl type to jsonb
5052
CONTEXT: PL/Perl function "testregexptojsonb"
53+
-- this revealed a bug in the original implementation
54+
CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
55+
LANGUAGE plperlu
56+
TRANSFORM FOR TYPE jsonb
57+
AS $$
58+
return ('1' =~ m(0\t2));
59+
$$;
60+
SELECT testRegexpResultToJsonb();
61+
testregexpresulttojsonb
62+
-------------------------
63+
0
64+
(1 row)
65+
5166
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
5267
LANGUAGE plperlu
5368
TRANSFORM FOR TYPE jsonb
@@ -201,11 +216,6 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
201216
{"1": {"2": [3, 4, 5]}, "2": 3}
202217
(1 row)
203218

219+
\set VERBOSITY terse \\ -- suppress cascade details
204220
DROP EXTENSION plperlu CASCADE;
205-
NOTICE: drop cascades to 6 other objects
206-
DETAIL: drop cascades to extension jsonb_plperlu
207-
drop cascades to function testhvtojsonb()
208-
drop cascades to function testavtojsonb()
209-
drop cascades to function testsvtojsonb()
210-
drop cascades to function testregexptojsonb()
211-
drop cascades to function roundtrip(jsonb)
221+
NOTICE: drop cascades to 7 other objects

‎contrib/jsonb_plperl/jsonb_plperl.c

Lines changed: 42 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
11
#include"postgres.h"
22

3+
#include<float.h>
4+
#include<math.h>
5+
6+
/* Defined by Perl */
37
#undef _
48

59
#include"fmgr.h"
610
#include"plperl.h"
711
#include"plperl_helpers.h"
8-
912
#include"utils/jsonb.h"
1013
#include"utils/fmgrprotos.h"
1114

@@ -188,46 +191,51 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
188191
caseSVt_PVHV:
189192
returnHV_to_JsonbValue((HV*)in,jsonb_state);
190193

191-
caseSVt_NV:
192-
caseSVt_IV:
194+
caseSVt_NULL:
195+
out.type=jbvNull;
196+
break;
197+
198+
default:
199+
if (SvIOK(in))
193200
{
194-
char*str=sv2cstr(in);
201+
IVival=SvIV(in);
195202

196-
/*
197-
* Use case-insensitive comparison because infinity
198-
* representation varies across Perl versions.
199-
*/
200-
if (pg_strcasecmp(str,"inf")==0)
203+
out.type=jbvNumeric;
204+
out.val.numeric=
205+
DatumGetNumeric(DirectFunctionCall1(int8_numeric,
206+
Int64GetDatum((int64)ival)));
207+
}
208+
elseif (SvNOK(in))
209+
{
210+
doublenval=SvNV(in);
211+
212+
if (isinf(nval))
201213
ereport(ERROR,
202-
(errcode(ERRCODE_INVALID_PARAMETER_VALUE),
214+
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
203215
(errmsg("cannot convert infinite value to jsonb"))));
204216

205217
out.type=jbvNumeric;
206-
out.val.numeric=DatumGetNumeric(DirectFunctionCall3(numeric_in,
207-
CStringGetDatum(str),0,-1));
218+
out.val.numeric=
219+
DatumGetNumeric(DirectFunctionCall1(float8_numeric,
220+
Float8GetDatum(nval)));
221+
}
222+
elseif (SvPOK(in))
223+
{
224+
out.type=jbvString;
225+
out.val.string.val=sv2cstr(in);
226+
out.val.string.len=strlen(out.val.string.val);
227+
}
228+
else
229+
{
230+
/*
231+
* XXX It might be nice if we could include the Perl type in
232+
* the error message.
233+
*/
234+
ereport(ERROR,
235+
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
236+
(errmsg("cannot transform this Perl type to jsonb"))));
237+
returnNULL;
208238
}
209-
break;
210-
211-
caseSVt_NULL:
212-
out.type=jbvNull;
213-
break;
214-
215-
caseSVt_PV:/* string */
216-
out.type=jbvString;
217-
out.val.string.val=sv2cstr(in);
218-
out.val.string.len=strlen(out.val.string.val);
219-
break;
220-
221-
default:
222-
223-
/*
224-
* XXX It might be nice if we could include the Perl type in the
225-
* error message.
226-
*/
227-
ereport(ERROR,
228-
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
229-
(errmsg("cannot transform this Perl type to jsonb"))));
230-
returnNULL;
231239
}
232240

233241
/* Push result into 'jsonb_state' unless it is a raw scalar. */

‎contrib/jsonb_plperl/sql/jsonb_plperl.sql

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,16 +34,29 @@ $$;
3434
SELECT testSVToJsonb();
3535

3636

37+
-- unsupported (for now)
3738
CREATEFUNCTIONtestRegexpToJsonb() RETURNS jsonb
3839
LANGUAGE plperl
3940
TRANSFORM FOR TYPE jsonb
4041
AS $$
41-
return ('1'=~ m(0\t2));
42+
my $a= qr/foo/;
43+
return ($a);
4244
$$;
4345

4446
SELECT testRegexpToJsonb();
4547

4648

49+
-- this revealed a bug in the original implementation
50+
CREATEFUNCTIONtestRegexpResultToJsonb() RETURNS jsonb
51+
LANGUAGE plperl
52+
TRANSFORM FOR TYPE jsonb
53+
AS $$
54+
return ('1'=~ m(0\t2));
55+
$$;
56+
57+
SELECT testRegexpResultToJsonb();
58+
59+
4760
CREATEFUNCTIONroundtrip(val jsonb) RETURNS jsonb
4861
LANGUAGE plperl
4962
TRANSFORM FOR TYPE jsonb
@@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
8396
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
8497

8598

99+
\set VERBOSITY terse \\-- suppress cascade details
86100
DROP EXTENSION plperl CASCADE;

‎contrib/jsonb_plperl/sql/jsonb_plperlu.sql

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,16 +34,29 @@ $$;
3434
SELECT testSVToJsonb();
3535

3636

37+
-- unsupported (for now)
3738
CREATEFUNCTIONtestRegexpToJsonb() RETURNS jsonb
3839
LANGUAGE plperlu
3940
TRANSFORM FOR TYPE jsonb
4041
AS $$
41-
return ('1'=~ m(0\t2));
42+
my $a= qr/foo/;
43+
return ($a);
4244
$$;
4345

4446
SELECT testRegexpToJsonb();
4547

4648

49+
-- this revealed a bug in the original implementation
50+
CREATEFUNCTIONtestRegexpResultToJsonb() RETURNS jsonb
51+
LANGUAGE plperlu
52+
TRANSFORM FOR TYPE jsonb
53+
AS $$
54+
return ('1'=~ m(0\t2));
55+
$$;
56+
57+
SELECT testRegexpResultToJsonb();
58+
59+
4760
CREATEFUNCTIONroundtrip(val jsonb) RETURNS jsonb
4861
LANGUAGE plperlu
4962
TRANSFORM FOR TYPE jsonb
@@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
8396
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
8497

8598

99+
\set VERBOSITY terse \\-- suppress cascade details
86100
DROP EXTENSION plperlu CASCADE;

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp