2 files changed, 533 insertions, 0 deletions
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out
new file mode 100644
index 0000000..5a73485
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -0,0 +1,253 @@
+CREATE EXTENSION jsonb_plperl CASCADE;
+NOTICE:  installing required extension "plperl"
+CREATE FUNCTION testHVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = {a => 1, b => 'boo', c => undef};
+return $val;
+$$;
+SELECT testHVToJsonb();
+          testhvtojsonb          
+---------------------------------
+ {"a": 1, "b": "boo", "c": null}
+(1 row)
+
+CREATE FUNCTION testAVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
+return $val;
+$$;
+SELECT testAVToJsonb();
+                testavtojsonb                
+---------------------------------------------
+ [{"a": 1, "b": "boo", "c": null}, {"d": 2}]
+(1 row)
+
+CREATE FUNCTION testSVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = 1;
+return $val;
+$$;
+SELECT testSVToJsonb();
+ 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
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+SELECT testRegexpResultToJsonb();
+ testregexpresulttojsonb 
+-------------------------
+ 0
+(1 row)
+
+-- this revealed a different bug
+CREATE FUNCTION testTextToJsonbObject(text) RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+my $x = shift;
+return {a => $x};
+$$;
+SELECT testTextToJsonbObject('abc');
+ testtexttojsonbobject 
+-----------------------
+ {"a": "abc"}
+(1 row)
+
+SELECT testTextToJsonbObject(NULL);
+ testtexttojsonbobject 
+-----------------------
+ {"a": null}
+(1 row)
+
+CREATE FUNCTION roundtrip(val jsonb, ref text = '') RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+# can't use Data::Dumper, but let's at least check for unexpected ref type
+die 'unexpected '.(ref($_[0]) || 'not a').' reference'
+    if ref($_[0]) ne $_[1];
+return $_[0];
+$$;
+SELECT roundtrip('null') is null;
+ ?column? 
+----------
+ t
+(1 row)
+
+SELECT roundtrip('1');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('1E+131071');
+ERROR:  cannot convert infinity to jsonb
+CONTEXT:  PL/Perl function "roundtrip"
+SELECT roundtrip('-1');
+ roundtrip 
+-----------
+ -1
+(1 row)
+
+SELECT roundtrip('1.2');
+ roundtrip 
+-----------
+ 1.2
+(1 row)
+
+SELECT roundtrip('-1.2');
+ roundtrip 
+-----------
+ -1.2
+(1 row)
+
+SELECT roundtrip('"string"');
+ roundtrip 
+-----------
+ "string"
+(1 row)
+
+SELECT roundtrip('"NaN"');
+ roundtrip 
+-----------
+ "NaN"
+(1 row)
+
+SELECT roundtrip('true');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('false');
+ roundtrip 
+-----------
+ 0
+(1 row)
+
+SELECT roundtrip('[]', 'ARRAY');
+ roundtrip 
+-----------
+ []
+(1 row)
+
+SELECT roundtrip('[null, null]', 'ARRAY');
+  roundtrip   
+--------------
+ [null, null]
+(1 row)
+
+SELECT roundtrip('[1, 2, 3]', 'ARRAY');
+ roundtrip 
+-----------
+ [1, 2, 3]
+(1 row)
+
+SELECT roundtrip('[-1, 2, -3]', 'ARRAY');
+  roundtrip  
+-------------
+ [-1, 2, -3]
+(1 row)
+
+SELECT roundtrip('[1.2, 2.3, 3.4]', 'ARRAY');
+    roundtrip    
+-----------------
+ [1.2, 2.3, 3.4]
+(1 row)
+
+SELECT roundtrip('[-1.2, 2.3, -3.4]', 'ARRAY');
+     roundtrip     
+-------------------
+ [-1.2, 2.3, -3.4]
+(1 row)
+
+SELECT roundtrip('["string1", "string2"]', 'ARRAY');
+       roundtrip        
+------------------------
+ ["string1", "string2"]
+(1 row)
+
+SELECT roundtrip('[["string1", "string2"]]', 'ARRAY');
+        roundtrip         
+--------------------------
+ [["string1", "string2"]]
+(1 row)
+
+SELECT roundtrip('{}', 'HASH');
+ roundtrip 
+-----------
+ {}
+(1 row)
+
+SELECT roundtrip('{"1": null}', 'HASH');
+  roundtrip  
+-------------
+ {"1": null}
+(1 row)
+
+SELECT roundtrip('{"1": 1}', 'HASH');
+ roundtrip 
+-----------
+ {"1": 1}
+(1 row)
+
+SELECT roundtrip('{"1": -1}', 'HASH');
+ roundtrip 
+-----------
+ {"1": -1}
+(1 row)
+
+SELECT roundtrip('{"1": 1.1}', 'HASH');
+ roundtrip  
+------------
+ {"1": 1.1}
+(1 row)
+
+SELECT roundtrip('{"1": -1.1}', 'HASH');
+  roundtrip  
+-------------
+ {"1": -1.1}
+(1 row)
+
+SELECT roundtrip('{"1": "string1"}', 'HASH');
+    roundtrip     
+------------------
+ {"1": "string1"}
+(1 row)
+
+SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH');
+            roundtrip            
+---------------------------------
+ {"1": {"2": [3, 4, 5]}, "2": 3}
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperl CASCADE;
+NOTICE:  drop cascades to 8 other objects
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu.out b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
new file mode 100644
index 0000000..dff316c
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
@@ -0,0 +1,280 @@
+CREATE EXTENSION jsonb_plperlu CASCADE;
+NOTICE:  installing required extension "plperlu"
+CREATE FUNCTION testHVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = {a => 1, b => 'boo', c => undef};
+return $val;
+$$;
+SELECT testHVToJsonb();
+          testhvtojsonb          
+---------------------------------
+ {"a": 1, "b": "boo", "c": null}
+(1 row)
+
+CREATE FUNCTION testAVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
+return $val;
+$$;
+SELECT testAVToJsonb();
+                testavtojsonb                
+---------------------------------------------
+ [{"a": 1, "b": "boo", "c": null}, {"d": 2}]
+(1 row)
+
+CREATE FUNCTION testSVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = 1;
+return $val;
+$$;
+SELECT testSVToJsonb();
+ 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
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+SELECT testRegexpResultToJsonb();
+ testregexpresulttojsonb 
+-------------------------
+ 0
+(1 row)
+
+-- this revealed a different bug
+CREATE FUNCTION testTextToJsonbObject(text) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+my $x = shift;
+return {a => $x};
+$$;
+SELECT testTextToJsonbObject('abc');
+ testtexttojsonbobject 
+-----------------------
+ {"a": "abc"}
+(1 row)
+
+SELECT testTextToJsonbObject(NULL);
+ testtexttojsonbobject 
+-----------------------
+ {"a": null}
+(1 row)
+
+CREATE FUNCTION roundtrip(val jsonb, ref text = '') RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+use Data::Dumper;
+$Data::Dumper::Sortkeys = 1;
+$Data::Dumper::Indent = 0;
+elog(INFO, Dumper($_[0]));
+die 'unexpected '.(ref($_[0]) || 'not a').' reference'
+    if ref($_[0]) ne $_[1];
+return $_[0];
+$$;
+SELECT roundtrip('null') is null;
+INFO:  $VAR1 = undef;
+ ?column? 
+----------
+ t
+(1 row)
+
+SELECT roundtrip('1');
+INFO:  $VAR1 = '1';
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+-- skip because Data::Dumper produces a platform-dependent spelling of infinity
+-- SELECT roundtrip('1E+131071');
+SELECT roundtrip('-1');
+INFO:  $VAR1 = '-1';
+ roundtrip 
+-----------
+ -1
+(1 row)
+
+SELECT roundtrip('1.2');
+INFO:  $VAR1 = '1.2';
+ roundtrip 
+-----------
+ 1.2
+(1 row)
+
+SELECT roundtrip('-1.2');
+INFO:  $VAR1 = '-1.2';
+ roundtrip 
+-----------
+ -1.2
+(1 row)
+
+SELECT roundtrip('"string"');
+INFO:  $VAR1 = 'string';
+ roundtrip 
+-----------
+ "string"
+(1 row)
+
+SELECT roundtrip('"NaN"');
+INFO:  $VAR1 = 'NaN';
+ roundtrip 
+-----------
+ "NaN"
+(1 row)
+
+SELECT roundtrip('true');
+INFO:  $VAR1 = '1';
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('false');
+INFO:  $VAR1 = '0';
+ roundtrip 
+-----------
+ 0
+(1 row)
+
+SELECT roundtrip('[]', 'ARRAY');
+INFO:  $VAR1 = [];
+ roundtrip 
+-----------
+ []
+(1 row)
+
+SELECT roundtrip('[null, null]', 'ARRAY');
+INFO:  $VAR1 = [undef,undef];
+  roundtrip   
+--------------
+ [null, null]
+(1 row)
+
+SELECT roundtrip('[1, 2, 3]', 'ARRAY');
+INFO:  $VAR1 = ['1','2','3'];
+ roundtrip 
+-----------
+ [1, 2, 3]
+(1 row)
+
+SELECT roundtrip('[-1, 2, -3]', 'ARRAY');
+INFO:  $VAR1 = ['-1','2','-3'];
+  roundtrip  
+-------------
+ [-1, 2, -3]
+(1 row)
+
+SELECT roundtrip('[1.2, 2.3, 3.4]', 'ARRAY');
+INFO:  $VAR1 = ['1.2','2.3','3.4'];
+    roundtrip    
+-----------------
+ [1.2, 2.3, 3.4]
+(1 row)
+
+SELECT roundtrip('[-1.2, 2.3, -3.4]', 'ARRAY');
+INFO:  $VAR1 = ['-1.2','2.3','-3.4'];
+     roundtrip     
+-------------------
+ [-1.2, 2.3, -3.4]
+(1 row)
+
+SELECT roundtrip('["string1", "string2"]', 'ARRAY');
+INFO:  $VAR1 = ['string1','string2'];
+       roundtrip        
+------------------------
+ ["string1", "string2"]
+(1 row)
+
+SELECT roundtrip('[["string1", "string2"]]', 'ARRAY');
+INFO:  $VAR1 = [['string1','string2']];
+        roundtrip         
+--------------------------
+ [["string1", "string2"]]
+(1 row)
+
+SELECT roundtrip('{}', 'HASH');
+INFO:  $VAR1 = {};
+ roundtrip 
+-----------
+ {}
+(1 row)
+
+SELECT roundtrip('{"1": null}', 'HASH');
+INFO:  $VAR1 = {'1' => undef};
+  roundtrip  
+-------------
+ {"1": null}
+(1 row)
+
+SELECT roundtrip('{"1": 1}', 'HASH');
+INFO:  $VAR1 = {'1' => '1'};
+ roundtrip 
+-----------
+ {"1": 1}
+(1 row)
+
+SELECT roundtrip('{"1": -1}', 'HASH');
+INFO:  $VAR1 = {'1' => '-1'};
+ roundtrip 
+-----------
+ {"1": -1}
+(1 row)
+
+SELECT roundtrip('{"1": 1.1}', 'HASH');
+INFO:  $VAR1 = {'1' => '1.1'};
+ roundtrip  
+------------
+ {"1": 1.1}
+(1 row)
+
+SELECT roundtrip('{"1": -1.1}', 'HASH');
+INFO:  $VAR1 = {'1' => '-1.1'};
+  roundtrip  
+-------------
+ {"1": -1.1}
+(1 row)
+
+SELECT roundtrip('{"1": "string1"}', 'HASH');
+INFO:  $VAR1 = {'1' => 'string1'};
+    roundtrip     
+------------------
+ {"1": "string1"}
+(1 row)
+
+SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH');
+INFO:  $VAR1 = {'1' => {'2' => ['3','4','5']},'2' => '3'};
+            roundtrip            
+---------------------------------
+ {"1": {"2": [3, 4, 5]}, "2": 3}
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 8 other objects