src/pl/plperl/expected/plperl_array.out - master - githubmirror/postgres

src/pl/plperl/expected/plperl_array.out
283 строки10 KB
Richard Guo
plperl: Fix NULL pointer dereference for forged array object
24 июн 2026, 03:09
24 июн 2026, 03:094015abe
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 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)

-- Test a forged PostgreSQL::InServer::ARRAY object lacking the 'array' key
CREATE OR REPLACE FUNCTION perl_forged_array() RETURNS integer[] AS $$
	return bless {}, "PostgreSQL::InServer::ARRAY";
$$ LANGUAGE plperl;
SELECT perl_forged_array();
ERROR:  could not get array reference from PostgreSQL::InServer::ARRAY object
CONTEXT:  PL/Perl function "perl_forged_array"