Adding upstream version 16.2.upstream/16.2

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 276 insertions, 0 deletions

diff --git a/src/pl/plperl/expected/plperl_array.out b/src/pl/plperl/expected/plperl_array.out
new file mode 100644
index 0000000..bd04a06
--- /dev/null
+++ b/src/pl/plperl/expected/plperl_array.out
@@ -0,0 +1,276 @@
+CREATE OR REPLACE FUNCTION plperl_sum_array(INTEGER[]) RETURNS text AS $$
+	my $array_arg = shift;
+	my $result = 0;
+	my @arrays;
+
+	push @arrays, @$array_arg;
+
+	while (@arrays > 0) {
+		my $el = shift @arrays;
+		if (is_array_ref($el)) {
+			push @arrays, @$el;
+		} else {
+			$result += $el;
+		}
+	}
+	return $result.' '.$array_arg;
+$$ LANGUAGE plperl;
+select plperl_sum_array('{1,2,NULL}');
+ plperl_sum_array 
+------------------
+ 3 {1,2,NULL}
+(1 row)
+
+select plperl_sum_array('{}');
+ plperl_sum_array 
+------------------
+ 0 {}
+(1 row)
+
+select plperl_sum_array('{{1,2,3}, {4,5,6}}');
+   plperl_sum_array   
+----------------------
+ 21 {{1,2,3},{4,5,6}}
+(1 row)
+
+select plperl_sum_array('{{{1,2,3}, {4,5,6}}, {{7,8,9}, {10,11,12}}}');
+              plperl_sum_array               
+---------------------------------------------
+ 78 {{{1,2,3},{4,5,6}},{{7,8,9},{10,11,12}}}
+(1 row)
+
+-- check whether we can handle arrays of maximum dimension (6)
+select plperl_sum_array(ARRAY[[[[[[1,2],[3,4]],[[5,6],[7,8]]],[[[9,10],[11,12]],
+[[13,14],[15,16]]]],
+[[[[17,18],[19,20]],[[21,22],[23,24]]],[[[25,26],[27,28]],[[29,30],[31,32]]]]],
+[[[[[1,2],[3,4]],[[5,6],[7,8]]],[[[9,10],[11,12]],[[13,14],[15,16]]]],
+[[[[17,18],[19,20]],[[21,22],[23,24]]],[[[25,26],[27,28]],[[29,30],[31,32]]]]]]);
+                                                                                                                                                 plperl_sum_array                                                                                                                                                 
+------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ 1056 {{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}}
+(1 row)
+
+-- what would we do with the arrays exceeding maximum dimension (7)
+select plperl_sum_array('{{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},
+{{13,14},{15,16}}}},
+{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},
+{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
+{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}},
+{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
+{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},
+{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
+{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}}}'
+);
+ERROR:  number of array dimensions (7) exceeds the maximum allowed (6)
+LINE 1: select plperl_sum_array('{{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{...
+                                ^
+select plperl_sum_array('{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {10, 11, 12}}}');
+ERROR:  malformed array literal: "{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {10, 11, 12}}}"
+LINE 1: select plperl_sum_array('{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {1...
+                                ^
+DETAIL:  Multidimensional arrays must have sub-arrays with matching dimensions.
+CREATE OR REPLACE FUNCTION plperl_concat(TEXT[]) RETURNS TEXT AS $$
+	my $array_arg = shift;
+	my $result = "";
+	my @arrays;
+
+	push @arrays, @$array_arg;
+	while (@arrays > 0) {
+		my $el = shift @arrays;
+		if (is_array_ref($el)) {
+			push @arrays, @$el;
+		} else {
+			$result .= $el;
+		}
+	}
+	return $result.' '.$array_arg;
+$$ LANGUAGE plperl;
+select plperl_concat('{"NULL","NULL","NULL''"}');
+            plperl_concat            
+-------------------------------------
+ NULLNULLNULL' {"NULL","NULL",NULL'}
+(1 row)
+
+select plperl_concat('{{NULL,NULL,NULL}}');
+    plperl_concat    
+---------------------
+  {{NULL,NULL,NULL}}
+(1 row)
+
+select plperl_concat('{"hello"," ","world!"}');
+          plperl_concat          
+---------------------------------
+ hello world! {hello," ",world!}
+(1 row)
+
+-- array of rows --
+CREATE TYPE foo AS (bar INTEGER, baz TEXT);
+CREATE OR REPLACE FUNCTION plperl_array_of_rows(foo[]) RETURNS TEXT AS $$
+	my $array_arg = shift;
+	my $result = "";
+
+	for my $row_ref (@$array_arg) {
+		die "not a hash reference" unless (ref $row_ref eq "HASH");
+			$result .= $row_ref->{bar}." items of ".$row_ref->{baz}.";";
+	}
+	return $result .' '. $array_arg;
+$$ LANGUAGE plperl;
+select plperl_array_of_rows(ARRAY[ ROW(2, 'coffee'), ROW(0, 'sugar')]::foo[]);
+                      plperl_array_of_rows                      
+----------------------------------------------------------------
+ 2 items of coffee;0 items of sugar; {"(2,coffee)","(0,sugar)"}
+(1 row)
+
+-- composite type containing arrays
+CREATE TYPE rowfoo AS (bar INTEGER, baz INTEGER[]);
+CREATE OR REPLACE FUNCTION plperl_sum_row_elements(rowfoo) RETURNS TEXT AS $$
+	my $row_ref = shift;
+	my $result;
+
+	if (ref $row_ref ne 'HASH') {
+		$result = 0;
+	}
+	else {
+		$result = $row_ref->{bar};
+		die "not an array reference".ref ($row_ref->{baz})
+		unless (is_array_ref($row_ref->{baz}));
+		# process a single-dimensional array
+		foreach my $elem (@{$row_ref->{baz}}) {
+			$result += $elem unless ref $elem;
+		}
+	}
+	return $result;
+$$ LANGUAGE plperl;
+select plperl_sum_row_elements(ROW(1, ARRAY[2,3,4,5,6,7,8,9,10])::rowfoo);
+ plperl_sum_row_elements 
+-------------------------
+ 55
+(1 row)
+
+-- composite type containing array of another composite type, which, in order,
+-- contains an array of integers.
+CREATE TYPE rowbar AS (foo rowfoo[]);
+CREATE OR REPLACE FUNCTION plperl_sum_array_of_rows(rowbar) RETURNS TEXT AS $$
+	my $rowfoo_ref = shift;
+	my $result = 0;
+
+	if (ref $rowfoo_ref eq 'HASH') {
+		my $row_array_ref = $rowfoo_ref->{foo};
+		if (is_array_ref($row_array_ref)) {
+			foreach my $row_ref (@{$row_array_ref}) {
+				if (ref $row_ref eq 'HASH') {
+					$result += $row_ref->{bar};
+					die "not an array reference".ref ($row_ref->{baz})
+					unless (is_array_ref($row_ref->{baz}));
+					foreach my $elem (@{$row_ref->{baz}}) {
+						$result += $elem unless ref $elem;
+					}
+				}
+				else {
+					die "element baz is not a reference to a rowfoo";
+				}
+			}
+		} else {
+			die "not a reference to an array of rowfoo elements"
+		}
+	} else {
+		die "not a reference to type rowbar";
+	}
+	return $result;
+$$ LANGUAGE plperl;
+select plperl_sum_array_of_rows(ROW(ARRAY[ROW(1, ARRAY[2,3,4,5,6,7,8,9,10])::rowfoo,
+ROW(11, ARRAY[12,13,14,15,16,17,18,19,20])::rowfoo])::rowbar);
+ plperl_sum_array_of_rows 
+--------------------------
+ 210
+(1 row)
+
+-- check arrays as out parameters
+CREATE OR REPLACE FUNCTION plperl_arrays_out(OUT INTEGER[]) AS $$
+	return [[1,2,3],[4,5,6]];
+$$ LANGUAGE plperl;
+select plperl_arrays_out();
+ plperl_arrays_out 
+-------------------
+ {{1,2,3},{4,5,6}}
+(1 row)
+
+-- check that we can return the array we passed in
+CREATE OR REPLACE FUNCTION plperl_arrays_inout(INTEGER[]) returns INTEGER[] AS $$
+	return shift;
+$$ LANGUAGE plperl;
+select plperl_arrays_inout('{{1}, {2}, {3}}');
+ plperl_arrays_inout 
+---------------------
+ {{1},{2},{3}}
+(1 row)
+
+-- check that we can return an array literal
+CREATE OR REPLACE FUNCTION plperl_arrays_inout_l(INTEGER[]) returns INTEGER[] AS $$
+	return shift.''; # stringify it
+$$ LANGUAGE plperl;
+select plperl_arrays_inout_l('{{1}, {2}, {3}}');
+ plperl_arrays_inout_l 
+-----------------------
+ {{1},{2},{3}}
+(1 row)
+
+-- check output of multi-dimensional arrays
+CREATE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [['a'], ['b'], ['c']];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();
+ plperl_md_array_out 
+---------------------
+ {{a},{b},{c}}
+(1 row)
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[], []];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();
+ plperl_md_array_out 
+---------------------
+ {}
+(1 row)
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[], [1]];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();  -- fail
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "plperl_md_array_out"
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[], 1];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();  -- fail
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "plperl_md_array_out"
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [1, []];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();  -- fail
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "plperl_md_array_out"
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[1], [[]]];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();  -- fail
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "plperl_md_array_out"
+-- make sure setof works
+create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
+	my $arr = shift;
+	for my $r (@$arr) {
+		return_next $r;
+	}
+	return undef;
+$$;
+select perl_setof_array('{{1}, {2}, {3}}');
+ perl_setof_array 
+------------------
+ {1}
+ {2}
+ {3}
+(3 rows)
+