Fix jsonb_plperl to convert Perl UV values correctly.

Values greater than IV_MAX were incorrectly converted to SQL,
for instance ~0 would become -1 rather than 18446744073709551615
(on a 64-bit machine).

Dagfinn Ilmari Mannsåker, adjusted a bit by me

Discussion: https://postgr.es/m/[email protected]

5 files changed, 72 insertions, 3 deletions

diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out
index d2d90eb4837..6dc090a87f7 100644
--- a/contrib/jsonb_plperl/expected/jsonb_plperl.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -39,6 +39,20 @@ SELECT testSVToJsonb();
  1
 (1 row)
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+-- this might produce either 18446744073709551615 or 4294967295
+SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb);
+ ?column? 
+----------
+ t
+(1 row)
+
 -- this revealed a bug in the original implementation
 CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
 LANGUAGE plperl
@@ -216,4 +230,4 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH');
 
 \set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperl CASCADE;
-NOTICE:  drop cascades to 6 other objects
+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 fe8ca19a719..434327bea02 100644
--- a/contrib/jsonb_plperl/expected/jsonb_plperlu.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
@@ -39,6 +39,20 @@ SELECT testSVToJsonb();
  1
 (1 row)
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+-- this might produce either 18446744073709551615 or 4294967295
+SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb);
+ ?column? 
+----------
+ t
+(1 row)
+
 -- this revealed a bug in the original implementation
 CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
 LANGUAGE plperlu
@@ -243,4 +257,4 @@ INFO:  $VAR1 = {'1' => {'2' => ['3','4','5']},'2' => '3'};
 
 \set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperlu CASCADE;
-NOTICE:  drop cascades to 6 other objects
+NOTICE:  drop cascades to 7 other objects
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 1b63fc4b307..e847ae53699 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -198,7 +198,24 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
 			break;
 
 		default:
-			if (SvIOK(in))
+			if (SvUOK(in))
+			{
+				/*
+				 * If UV is >=64 bits, we have no better way to make this
+				 * happen than converting to text and back.  Given the low
+				 * usage of UV in Perl code, it's not clear it's worth working
+				 * hard to provide alternate code paths.
+				 */
+				const char *strval = SvPV_nolen(in);
+
+				out.type = jbvNumeric;
+				out.val.numeric =
+					DatumGetNumeric(DirectFunctionCall3(numeric_in,
+														CStringGetDatum(strval),
+														ObjectIdGetDatum(InvalidOid),
+														Int32GetDatum(-1)));
+			}
+			else if (SvIOK(in))
 			{
 				IV			ival = SvIV(in);
 
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl.sql b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
index 642a71deb76..8b062dfc6bb 100644
--- a/contrib/jsonb_plperl/sql/jsonb_plperl.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
@@ -34,6 +34,18 @@ $$;
 SELECT testSVToJsonb();
 
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+
+-- this might produce either 18446744073709551615 or 4294967295
+SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb);
+
+
 -- this revealed a bug in the original implementation
 CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
 LANGUAGE plperl
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
index 907dd4f73c8..8d8e8415405 100644
--- a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
@@ -34,6 +34,18 @@ $$;
 SELECT testSVToJsonb();
 
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+
+-- this might produce either 18446744073709551615 or 4294967295
+SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb);
+
+
 -- this revealed a bug in the original implementation
 CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb
 LANGUAGE plperlu