Fix up Perl-to-Postgres datatype conversions in pl/perl.

This patch restores the pre-9.1 behavior that pl/perl functions returning
VOID ignore the result value of their last Perl statement.  9.1.0
unintentionally threw an error if the last statement returned a reference,
as reported by Amit Khandekar.

Also, make sure it works to return a string value for a composite type,
so long as the string meets the type's input format.  We already allowed
the equivalent behavior for arrays, so it seems inconsistent to not allow
it for composites.

In addition, ensure we throw errors for attempts to return arrays or hashes
when the function's declared result type is not an array or composite type,
respectively.  Pre-9.1 versions rather uselessly returned strings like
ARRAY(0x221a9a0) or HASH(0x221aa90), while 9.1.0 threw an error for the
hash case and returned a garbage value for the array case.

Also, clean up assorted grotty coding in Perl array conversion, including
use of a session-lifespan memory context to accumulate the array value
(resulting in session-lifespan memory leak on error), failure to apply the
declared typmod if any, and failure to detect some cases of non-rectangular
multi-dimensional arrays.

Alex Hunsaker and Tom Lane

src/pl/plperl/expected/plperl.out

@@ -101,6 +101,16 @@ SELECT * FROM perl_row();
   1 | hello | world | ({{1}})
 (1 row)
 
+-- test returning a composite literal
+CREATE OR REPLACE FUNCTION perl_row_lit() RETURNS testrowperl AS $$
+    return '(1,hello,world,"({{1}})")';
+$$ LANGUAGE plperl;
+SELECT perl_row_lit();
+       perl_row_lit        
+---------------------------
+ (1,hello,world,"({{1}})")
+(1 row)
+
 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
     return undef;
 $$  LANGUAGE plperl;
@@ -336,7 +346,8 @@ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 return 42;
 $$ LANGUAGE plperl;
 SELECT * FROM foo_bad();
-ERROR:  composite-returning PL/Perl function must return reference to hash
+ERROR:  malformed record literal: "42"
+DETAIL:  Missing left parenthesis.
 CONTEXT:  PL/Perl function "foo_bad"
 CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
 return [
@@ -345,7 +356,7 @@ return [
 ];
 $$ LANGUAGE plperl;
 SELECT * FROM foo_bad();
-ERROR:  composite-returning PL/Perl function must return reference to hash
+ERROR:  cannot convert Perl array to non-array type footype
 CONTEXT:  PL/Perl function "foo_bad"
 CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
     return 42;
@@ -639,3 +650,46 @@ CONTEXT:  PL/Perl anonymous code block
 DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
 ERROR:  Useless use of sort in scalar context at line 1.
 CONTEXT:  PL/Perl anonymous code block
+-- make sure functions marked as VOID without an explicit return work
+CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$
+   $_SHARED{myquote} = sub {
+       my $arg = shift;
+       $arg =~ s/(['\\])/\\$1/g;
+       return "'$arg'";
+   };
+$$ LANGUAGE plperl;
+SELECT myfuncs();
+ myfuncs 
+---------
+ 
+(1 row)
+
+-- make sure we can't return an array as a scalar
+CREATE OR REPLACE FUNCTION text_arrayref() RETURNS text AS $$
+	return ['array'];
+$$ LANGUAGE plperl;
+SELECT text_arrayref();
+ERROR:  cannot convert Perl array to non-array type text
+CONTEXT:  PL/Perl function "text_arrayref"
+--- make sure we can't return a hash as a scalar
+CREATE OR REPLACE FUNCTION text_hashref() RETURNS text AS $$
+	return {'hash'=>1};
+$$ LANGUAGE plperl;
+SELECT text_hashref();
+ERROR:  cannot convert Perl hash to non-composite type text
+CONTEXT:  PL/Perl function "text_hashref"
+---- make sure we can't return a blessed object as a scalar
+CREATE OR REPLACE FUNCTION text_obj() RETURNS text AS $$
+	return bless({}, 'Fake::Object');
+$$ LANGUAGE plperl;
+SELECT text_obj();
+ERROR:  cannot convert Perl hash to non-composite type text
+CONTEXT:  PL/Perl function "text_obj"
+----- make sure we can't return a scalar ref
+CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$
+	my $str = 'str';
+	return \$str;
+$$ LANGUAGE plperl;
+SELECT text_scalarref();
+ERROR:  PL/Perl function must return reference to hash or array
+CONTEXT:  PL/Perl function "text_scalarref"

src/pl/plperl/expected/plperl_array.out

@@ -204,6 +204,16 @@ select plperl_arrays_inout('{{1}, {2}, {3}}');
  {{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)
+
 -- make sure setof works
 create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
 	my $arr = shift;

src/pl/plperl/plperl.c

@@ -155,7 +155,6 @@ typedef struct plperl_call_data
 	FunctionCallInfo fcinfo;
 	Tuplestorestate *tuple_store;
 	TupleDesc	ret_tdesc;
-	AttInMetadata *attinmeta;
 	MemoryContext tmp_cxt;
 } plperl_call_data;
 
@@ -244,12 +243,16 @@ static SV  *plperl_ref_from_pg_array(Datum arg, Oid typid);
 static SV  *split_array(plperl_array_info *info, int first, int last, int nest);
 static SV  *make_array_ref(plperl_array_info *info, int first, int last);
 static SV  *get_perl_array_ref(SV *sv);
-static Datum plperl_sv_to_datum(SV *sv, FmgrInfo *func, Oid typid,
-				   Oid typioparam, int32 typmod, bool *isnull);
-static void _sv_to_datum_finfo(FmgrInfo *fcinfo, Oid typid, Oid *typioparam);
-static Datum plperl_array_to_datum(SV *src, Oid typid);
-static ArrayBuildState *_array_to_datum(AV *av, int *ndims, int *dims,
-			  int cur_depth, ArrayBuildState *astate, Oid typid, Oid atypid);
+static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
+				   FunctionCallInfo fcinfo,
+				   FmgrInfo *finfo, Oid typioparam,
+				   bool *isnull);
+static void _sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam);
+static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod);
+static ArrayBuildState *array_to_datum_internal(AV *av, ArrayBuildState *astate,
+						int *ndims, int *dims, int cur_depth,
+						Oid arraytypid, Oid elemtypid, int32 typmod,
+						FmgrInfo *finfo, Oid typioparam);
 static Datum plperl_hash_to_datum(SV *src, TupleDesc td);
 
 static void plperl_init_shared_libs(pTHX);
@@ -988,9 +991,8 @@ strip_trailing_ws(const char *msg)
 /* Build a tuple from a hash. */
 
 static HeapTuple
-plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
+plperl_build_tuple_result(HV *perlhash, TupleDesc td)
 {
-	TupleDesc	td = attinmeta->tupdesc;
 	Datum	   *values;
 	bool	   *nulls;
 	HE		   *he;
@@ -1006,7 +1008,6 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
 		SV		   *val = HeVAL(he);
 		char	   *key = hek2cstr(he);
 		int			attn = SPI_fnumber(td, key);
-		bool		isnull;
 
 		if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
 			ereport(ERROR,
@@ -1015,12 +1016,12 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
 							key)));
 
 		values[attn - 1] = plperl_sv_to_datum(val,
-											  NULL,
 											  td->attrs[attn - 1]->atttypid,
-											  InvalidOid,
 											  td->attrs[attn - 1]->atttypmod,
-											  &isnull);
-		nulls[attn - 1] = isnull;
+											  NULL,
+											  NULL,
+											  InvalidOid,
+											  &nulls[attn - 1]);
 
 		pfree(key);
 	}
@@ -1036,8 +1037,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
 static Datum
 plperl_hash_to_datum(SV *src, TupleDesc td)
 {
-	AttInMetadata *attinmeta = TupleDescGetAttInMetadata(td);
-	HeapTuple	tup = plperl_build_tuple_result((HV *) SvRV(src), attinmeta);
+	HeapTuple	tup = plperl_build_tuple_result((HV *) SvRV(src), td);
 
 	return HeapTupleGetDatum(tup);
 }
@@ -1069,13 +1069,15 @@ get_perl_array_ref(SV *sv)
 }
 
 /*
- * helper function for plperl_array_to_datum, does the main recursing
+ * helper function for plperl_array_to_datum, recurses for multi-D arrays
  */
 static ArrayBuildState *
-_array_to_datum(AV *av, int *ndims, int *dims, int cur_depth,
-				ArrayBuildState *astate, Oid typid, Oid atypid)
+array_to_datum_internal(AV *av, ArrayBuildState *astate,
+						int *ndims, int *dims, int cur_depth,
+						Oid arraytypid, Oid elemtypid, int32 typmod,
+						FmgrInfo *finfo, Oid typioparam)
 {
-	int			i = 0;
+	int			i;
 	int			len = av_len(av) + 1;
 
 	for (i = 0; i < len; i++)
@@ -1091,36 +1093,51 @@ _array_to_datum(AV *av, int *ndims, int *dims, int cur_depth,
 		{
 			AV		   *nav = (AV *) SvRV(sav);
 
+			/* dimensionality checks */
 			if (cur_depth + 1 > MAXDIM)
 				ereport(ERROR,
 						(errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
 						 errmsg("number of array dimensions (%d) exceeds the maximum allowed (%d)",
 								cur_depth + 1, MAXDIM)));
 
-			/* size based off the first element */
+			/* set size when at first element in this level, else compare */
 			if (i == 0 && *ndims == cur_depth)
 			{
 				dims[*ndims] = av_len(nav) + 1;
 				(*ndims)++;
 			}
-			else
-			{
-				if (av_len(nav) + 1 != dims[cur_depth])
-					ereport(ERROR,
-							(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
-							 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
-			}
-
-			astate = _array_to_datum(nav, ndims, dims, cur_depth + 1, astate,
-									 typid, atypid);
+			else if (av_len(nav) + 1 != dims[cur_depth])
+				ereport(ERROR,
+						(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
+						 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
+
+			/* recurse to fetch elements of this sub-array */
+			astate = array_to_datum_internal(nav, astate,
+											 ndims, dims, cur_depth + 1,
+											 arraytypid, elemtypid, typmod,
+											 finfo, typioparam);
 		}
 		else
 		{
+			Datum		dat;
 			bool		isnull;
-			Datum		dat = plperl_sv_to_datum(svp ? *svp : NULL, NULL,
-												 atypid, 0, -1, &isnull);
 
-			astate = accumArrayResult(astate, dat, isnull, atypid, NULL);
+			/* scalar after some sub-arrays at same level? */
+			if (*ndims != cur_depth)
+				ereport(ERROR,
+						(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
+						 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
+
+			dat = plperl_sv_to_datum(svp ? *svp : NULL,
+									 elemtypid,
+									 typmod,
+									 NULL,
+									 finfo,
+									 typioparam,
+									 &isnull);
+
+			astate = accumArrayResult(astate, dat, isnull,
+									  elemtypid, CurrentMemoryContext);
 		}
 	}
 
@@ -1131,89 +1148,141 @@ _array_to_datum(AV *av, int *ndims, int *dims, int cur_depth,
  * convert perl array ref to a datum
  */
 static Datum
-plperl_array_to_datum(SV *src, Oid typid)
+plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
 {
-	ArrayBuildState *astate = NULL;
-	Oid			atypid;
+	ArrayBuildState *astate;
+	Oid			elemtypid;
+	FmgrInfo	finfo;
+	Oid			typioparam;
 	int			dims[MAXDIM];
 	int			lbs[MAXDIM];
 	int			ndims = 1;
 	int			i;
 
-	atypid = get_element_type(typid);
-	if (!atypid)
-		atypid = typid;
+	elemtypid = get_element_type(typid);
+	if (!elemtypid)
+		ereport(ERROR,
+				(errcode(ERRCODE_DATATYPE_MISMATCH),
+				 errmsg("cannot convert Perl array to non-array type %s",
+						format_type_be(typid))));
+
+	_sv_to_datum_finfo(elemtypid, &finfo, &typioparam);
 
 	memset(dims, 0, sizeof(dims));
 	dims[0] = av_len((AV *) SvRV(src)) + 1;
 
-	astate = _array_to_datum((AV *) SvRV(src), &ndims, dims, 1, astate, typid,
-							 atypid);
+	astate = array_to_datum_internal((AV *) SvRV(src), NULL,
+									 &ndims, dims, 1,
+									 typid, elemtypid, typmod,
+									 &finfo, typioparam);
 
 	if (!astate)
-		return PointerGetDatum(construct_empty_array(atypid));
+		return PointerGetDatum(construct_empty_array(elemtypid));
 
 	for (i = 0; i < ndims; i++)
 		lbs[i] = 1;
 
-	return makeMdArrayResult(astate, ndims, dims, lbs, CurrentMemoryContext, true);
+	return makeMdArrayResult(astate, ndims, dims, lbs,
+							 CurrentMemoryContext, true);
 }
 
+/* Get the information needed to convert data to the specified PG type */
 static void
-_sv_to_datum_finfo(FmgrInfo *fcinfo, Oid typid, Oid *typioparam)
+_sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam)
 {
 	Oid			typinput;
 
 	/* XXX would be better to cache these lookups */
 	getTypeInputInfo(typid,
 					 &typinput, typioparam);
-	fmgr_info(typinput, fcinfo);
+	fmgr_info(typinput, finfo);
 }
 
 /*
- * convert a sv to datum
- * fcinfo and typioparam are optional and will be looked-up if needed
+ * convert Perl SV to PG datum of type typid, typmod typmod
+ *
+ * Pass the PL/Perl function's fcinfo when attempting to convert to the
+ * function's result type; otherwise pass NULL.  This is used when we need to
+ * resolve the actual result type of a function returning RECORD.
+ *
+ * finfo and typioparam should be the results of _sv_to_datum_finfo for the
+ * given typid, or NULL/InvalidOid to let this function do the lookups.
+ *
+ * *isnull is an output parameter.
  */
 static Datum
-plperl_sv_to_datum(SV *sv, FmgrInfo *finfo, Oid typid, Oid typioparam,
-				   int32 typmod, bool *isnull)
+plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
+				   FunctionCallInfo fcinfo,
+				   FmgrInfo *finfo, Oid typioparam,
+				   bool *isnull)
 {
 	FmgrInfo	tmp;
 
 	/* we might recurse */
 	check_stack_depth();
 
-	if (isnull)
-		*isnull = false;
+	*isnull = false;
 
-	if (!sv || !SvOK(sv))
+	/*
+	 * Return NULL if result is undef, or if we're in a function returning
+	 * VOID.  In the latter case, we should pay no attention to the last Perl
+	 * statement's result, and this is a convenient means to ensure that.
+	 */
+	if (!sv || !SvOK(sv) || typid == VOIDOID)
 	{
+		/* look up type info if they did not pass it */
 		if (!finfo)
 		{
-			_sv_to_datum_finfo(&tmp, typid, &typioparam);
+			_sv_to_datum_finfo(typid, &tmp, &typioparam);
 			finfo = &tmp;
 		}
-		if (isnull)
-			*isnull = true;
+		*isnull = true;
+		/* must call typinput in case it wants to reject NULL */
 		return InputFunctionCall(finfo, NULL, typioparam, typmod);
 	}
 	else if (SvROK(sv))
 	{
+		/* handle references */
 		SV		   *sav = get_perl_array_ref(sv);
 
 		if (sav)
 		{
-			return plperl_array_to_datum(sav, typid);
+			/* handle an arrayref */
+			return plperl_array_to_datum(sav, typid, typmod);
 		}
 		else if (SvTYPE(SvRV(sv)) == SVt_PVHV)
 		{
-			TupleDesc	td = lookup_rowtype_tupdesc(typid, typmod);
-			Datum		ret = plperl_hash_to_datum(sv, td);
+			/* handle a hashref */
+			Datum		ret;
+			TupleDesc	td;
 
+			if (!type_is_rowtype(typid))
+				ereport(ERROR,
+						(errcode(ERRCODE_DATATYPE_MISMATCH),
+						 errmsg("cannot convert Perl hash to non-composite type %s",
+								format_type_be(typid))));
+
+			td = lookup_rowtype_tupdesc_noerror(typid, typmod, true);
+			if (td == NULL)
+			{
+				/* Try to look it up based on our result type */
+				if (fcinfo == NULL ||
+					get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
+					ereport(ERROR,
+							(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+							 errmsg("function returning record called in context "
+									"that cannot accept type record")));
+			}
+
+			ret = plperl_hash_to_datum(sv, td);
+
+			/* Release on the result of get_call_result_type is harmless */
 			ReleaseTupleDesc(td);
+
 			return ret;
 		}
 
+		/* Reference, but not reference to hash or array ... */
 		ereport(ERROR,
 				(errcode(ERRCODE_DATATYPE_MISMATCH),
 		 errmsg("PL/Perl function must return reference to hash or array")));
@@ -1221,12 +1290,14 @@ plperl_sv_to_datum(SV *sv, FmgrInfo *finfo, Oid typid, Oid typioparam,
 	}
 	else
 	{
+		/* handle a string/number */
 		Datum		ret;
 		char	   *str = sv2cstr(sv);
 
+		/* did not pass in any typeinfo? look it up */
 		if (!finfo)
 		{
-			_sv_to_datum_finfo(&tmp, typid, &typioparam);
+			_sv_to_datum_finfo(typid, &tmp, &typioparam);
 			finfo = &tmp;
 		}
 
@@ -1251,7 +1322,10 @@ plperl_sv_to_literal(SV *sv, char *fqtypename)
 	if (!OidIsValid(typid))
 		elog(ERROR, "lookup failed for type %s", fqtypename);
 
-	datum = plperl_sv_to_datum(sv, NULL, typid, 0, -1, &isnull);
+	datum = plperl_sv_to_datum(sv,
+							   typid, -1,
+							   NULL, NULL, InvalidOid,
+							   &isnull);
 
 	if (isnull)
 		return NULL;
@@ -1542,10 +1616,11 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
 							key)));
 
 		modvalues[slotsused] = plperl_sv_to_datum(val,
-												  NULL,
 										  tupdesc->attrs[attn - 1]->atttypid,
-												  InvalidOid,
 										 tupdesc->attrs[attn - 1]->atttypmod,
+												  NULL,
+												  NULL,
+												  InvalidOid,
 												  &isnull);
 
 		modnulls[slotsused] = isnull ? 'n' : ' ';
@@ -2043,10 +2118,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 	Datum		retval = 0;
 	ReturnSetInfo *rsi;
 	ErrorContextCallback pl_error_context;
-	bool		has_retval = false;
 
 	/*
-	 * Create the call_data beforing connecting to SPI, so that it is not
+	 * Create the call_data before connecting to SPI, so that it is not
 	 * allocated in the SPI memory context
 	 */
 	current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
@@ -2129,51 +2203,19 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 			rsi->setDesc = current_call_data->ret_tdesc;
 		}
 		retval = (Datum) 0;
-		has_retval = true;
 	}
-	else if (!SvOK(perlret))
-	{
-		/* Return NULL if Perl code returned undef */
-		if (rsi && IsA(rsi, ReturnSetInfo))
-			rsi->isDone = ExprEndResult;
-	}
-	else if (prodesc->fn_retistuple)
-	{
-		/* Return a perl hash converted to a Datum */
-		TupleDesc	td;
-
-		if (!SvOK(perlret) || !SvROK(perlret) ||
-			SvTYPE(SvRV(perlret)) != SVt_PVHV)
-		{
-			ereport(ERROR,
-					(errcode(ERRCODE_DATATYPE_MISMATCH),
-					 errmsg("composite-returning PL/Perl function "
-							"must return reference to hash")));
-		}
-
-		/* XXX should cache the attinmeta data instead of recomputing */
-		if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
-		{
-			ereport(ERROR,
-					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
-					 errmsg("function returning record called in context "
-							"that cannot accept type record")));
-		}
-
-		retval = plperl_hash_to_datum(perlret, td);
-		has_retval = true;
-	}
-
-	if (!has_retval)
+	else
 	{
-		bool		isnull;
-
 		retval = plperl_sv_to_datum(perlret,
-									&prodesc->result_in_func,
 									prodesc->result_oid,
-									prodesc->result_typioparam, -1, &isnull);
-		fcinfo->isnull = isnull;
-		has_retval = true;
+									-1,
+									fcinfo,
+									&prodesc->result_in_func,
+									prodesc->result_typioparam,
+									&fcinfo->isnull);
+
+		if (fcinfo->isnull && rsi && IsA(rsi, ReturnSetInfo))
+			rsi->isDone = ExprEndResult;
 	}
 
 	/* Restore the previous error callback */
@@ -2196,7 +2238,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
 	ErrorContextCallback pl_error_context;
 
 	/*
-	 * Create the call_data beforing connecting to SPI, so that it is not
+	 * Create the call_data before connecting to SPI, so that it is not
 	 * allocated in the SPI memory context
 	 */
 	current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
@@ -2842,19 +2884,11 @@ plperl_return_next(SV *sv)
 				(errcode(ERRCODE_SYNTAX_ERROR),
 				 errmsg("cannot use return_next in a non-SETOF function")));
 
-	if (prodesc->fn_retistuple &&
-		!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
-		ereport(ERROR,
-				(errcode(ERRCODE_DATATYPE_MISMATCH),
-				 errmsg("SETOF-composite-returning PL/Perl function "
-						"must call return_next with reference to hash")));
-
 	if (!current_call_data->ret_tdesc)
 	{
 		TupleDesc	tupdesc;
 
 		Assert(!current_call_data->tuple_store);
-		Assert(!current_call_data->attinmeta);
 
 		/*
 		 * This is the first call to return_next in the current PL/Perl
@@ -2875,11 +2909,6 @@ plperl_return_next(SV *sv)
 		current_call_data->tuple_store =
 			tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
 								  false, work_mem);
-		if (prodesc->fn_retistuple)
-		{
-			current_call_data->attinmeta =
-				TupleDescGetAttInMetadata(current_call_data->ret_tdesc);
-		}
 
 		MemoryContextSwitchTo(old_cxt);
 	}
@@ -2893,7 +2922,7 @@ plperl_return_next(SV *sv)
 	if (!current_call_data->tmp_cxt)
 	{
 		current_call_data->tmp_cxt =
-			AllocSetContextCreate(rsi->econtext->ecxt_per_tuple_memory,
+			AllocSetContextCreate(CurrentMemoryContext,
 								  "PL/Perl return_next temporary cxt",
 								  ALLOCSET_DEFAULT_MINSIZE,
 								  ALLOCSET_DEFAULT_INITSIZE,
@@ -2906,8 +2935,14 @@ plperl_return_next(SV *sv)
 	{
 		HeapTuple	tuple;
 
+		if (!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
+			ereport(ERROR,
+					(errcode(ERRCODE_DATATYPE_MISMATCH),
+					 errmsg("SETOF-composite-returning PL/Perl function "
+							"must call return_next with reference to hash")));
+
 		tuple = plperl_build_tuple_result((HV *) SvRV(sv),
-										  current_call_data->attinmeta);
+										  current_call_data->ret_tdesc);
 		tuplestore_puttuple(current_call_data->tuple_store, tuple);
 	}
 	else
@@ -2916,10 +2951,12 @@ plperl_return_next(SV *sv)
 		bool		isNull;
 
 		ret = plperl_sv_to_datum(sv,
-								 &prodesc->result_in_func,
 								 prodesc->result_oid,
+								 -1,
+								 fcinfo,
+								 &prodesc->result_in_func,
 								 prodesc->result_typioparam,
-								 -1, &isNull);
+								 &isNull);
 
 		tuplestore_putvalues(current_call_data->tuple_store,
 							 current_call_data->ret_tdesc,
@@ -3318,10 +3355,12 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
 			bool		isnull;
 
 			argvalues[i] = plperl_sv_to_datum(argv[i],
-											  &qdesc->arginfuncs[i],
 											  qdesc->argtypes[i],
+											  -1,
+											  NULL,
+											  &qdesc->arginfuncs[i],
 											  qdesc->argtypioparams[i],
-											  -1, &isnull);
+											  &isnull);
 			nulls[i] = isnull ? 'n' : ' ';
 		}
 
@@ -3443,10 +3482,12 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
 			bool		isnull;
 
 			argvalues[i] = plperl_sv_to_datum(argv[i],
-											  &qdesc->arginfuncs[i],
 											  qdesc->argtypes[i],
+											  -1,
+											  NULL,
+											  &qdesc->arginfuncs[i],
 											  qdesc->argtypioparams[i],
-											  -1, &isnull);
+											  &isnull);
 			nulls[i] = isnull ? 'n' : ' ';
 		}
 

src/pl/plperl/sql/plperl.sql

@@ -50,6 +50,13 @@ $$ LANGUAGE plperl;
 SELECT perl_row();
 SELECT * FROM perl_row();
 
+-- test returning a composite literal
+CREATE OR REPLACE FUNCTION perl_row_lit() RETURNS testrowperl AS $$
+    return '(1,hello,world,"({{1}})")';
+$$ LANGUAGE plperl;
+
+SELECT perl_row_lit();
+
 
 CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
     return undef;
@@ -415,3 +422,43 @@ DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
 -- check that we can "use warnings" (in this case to turn a warn into an error)
 -- yields "ERROR:  Useless use of sort in scalar context."
 DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
+
+-- make sure functions marked as VOID without an explicit return work
+CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$
+   $_SHARED{myquote} = sub {
+       my $arg = shift;
+       $arg =~ s/(['\\])/\\$1/g;
+       return "'$arg'";
+   };
+$$ LANGUAGE plperl;
+
+SELECT myfuncs();
+
+-- make sure we can't return an array as a scalar
+CREATE OR REPLACE FUNCTION text_arrayref() RETURNS text AS $$
+	return ['array'];
+$$ LANGUAGE plperl;
+
+SELECT text_arrayref();
+
+--- make sure we can't return a hash as a scalar
+CREATE OR REPLACE FUNCTION text_hashref() RETURNS text AS $$
+	return {'hash'=>1};
+$$ LANGUAGE plperl;
+
+SELECT text_hashref();
+
+---- make sure we can't return a blessed object as a scalar
+CREATE OR REPLACE FUNCTION text_obj() RETURNS text AS $$
+	return bless({}, 'Fake::Object');
+$$ LANGUAGE plperl;
+
+SELECT text_obj();
+
+----- make sure we can't return a scalar ref
+CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$
+	my $str = 'str';
+	return \$str;
+$$ LANGUAGE plperl;
+
+SELECT text_scalarref();

src/pl/plperl/sql/plperl_array.sql

@@ -152,6 +152,13 @@ $$ LANGUAGE plperl;
 
 select plperl_arrays_inout('{{1}, {2}, {3}}');
 
+-- 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}}');
+
 -- make sure setof works
 create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
 	my $arr = shift;