- allow pg.spi.prepare/pg.spi.execp to use parameters which are 1D ar…

…rays

pg_conversion.c

@@ -41,6 +41,7 @@ static Datum get_trigger_tuple(SEXP rval, plr_function *function,
 									FunctionCallInfo fcinfo, bool *isnull);
 static Datum get_tuplestore(SEXP rval, plr_function *function,
 									FunctionCallInfo fcinfo, bool *isnull);
+static Datum get_simple_array_datum(SEXP rval, Oid typelem, bool *isnull);
 static Datum get_array_datum(SEXP rval, plr_function *function, int col, bool *isnull);
 static Datum get_frame_array_datum(SEXP rval, plr_function *function, int col,
 																bool *isnull);
@@ -367,7 +368,7 @@ pg_tuple_get_r_frame(int ntuples, HeapTuple *tuples, TupleDesc tupdesc)
 		bool		typbyval;
 		char		typdelim;
 		Oid			typoutput,
-					elemtypelem;
+					typioparam;
 		FmgrInfo	outputproc;
 		char		typalign;
 
@@ -395,7 +396,7 @@ pg_tuple_get_r_frame(int ntuples, HeapTuple *tuples, TupleDesc tupdesc)
 		{
 			PROTECT(fldvec = NEW_LIST(nr));
 			get_type_io_data(typelem, IOFunc_output, &typlen, &typbyval,
-							 &typalign, &typdelim, &elemtypelem, &typoutput);
+							 &typalign, &typdelim, &typioparam, &typoutput);
 
 			fmgr_info(typoutput, &outputproc);
 		}
@@ -578,6 +579,30 @@ r_get_pg(SEXP rval, plr_function *function, FunctionCallInfo fcinfo)
 	return result;
 }
 
+/*
+ * Similar to r_get_pg, given an R value, convert to its pg representation
+ * Other than scalar, currently only prepared to be used with simple 1D vector
+ */
+Datum
+get_datum(SEXP rval, Oid typid, Oid typelem, FmgrInfo in_func, bool *isnull)
+{
+	Datum	result;
+
+	/* short circuit if return value is Null */
+	if (rval == R_NilValue || isNull(rval))	/* probably redundant */
+	{
+		*isnull = true;
+		return (Datum) 0;
+	}
+
+	if (typelem == InvalidOid)
+		result = get_scalar_datum(rval, typid, in_func, isnull);
+	else
+		result = get_simple_array_datum(rval, typelem, isnull);
+
+	return result;
+}
+
 static Datum
 get_trigger_tuple(SEXP rval, plr_function *function, FunctionCallInfo fcinfo, bool *isnull)
 {
@@ -1066,6 +1091,96 @@ get_frame_array_datum(SEXP rval, plr_function *function, int col, bool *isnull)
 	return dvalue;
 }
 
+/* return simple, one dimensional array */
+static Datum
+get_simple_array_datum(SEXP rval, Oid typelem, bool *isnull)
+{
+	Datum		dvalue;
+	SEXP		obj;
+	SEXP		rdims;
+	const char *value;
+	int16		typlen;
+	bool		typbyval;
+	char		typdelim;
+	Oid			typinput,
+				typioparam;
+	FmgrInfo	in_func;
+	char		typalign;
+	int			i;
+	Datum	   *dvalues = NULL;
+	ArrayType  *array;
+	int			nitems;
+	int		   *dims;
+	int		   *lbs;
+	bool	   *nulls;
+	bool		have_nulls = FALSE;
+	int			ndims = 1;
+
+	dims = palloc(ndims * sizeof(int));
+	lbs = palloc(ndims * sizeof(int));
+
+	/*
+	 * get the element type's in_func
+	 */
+	get_type_io_data(typelem, IOFunc_output, &typlen, &typbyval,
+					 &typalign, &typdelim, &typioparam, &typinput);
+
+	perm_fmgr_info(typinput, &in_func);
+
+	PROTECT(rdims = getAttrib(rval, R_DimSymbol));
+	if (length(rdims) > 1)
+		ereport(ERROR,
+				(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+				 errmsg("greater than 1-dimensional arrays are " \
+						"not supported in this context")));
+
+	dims[0] = INTEGER(rdims)[0];
+	lbs[0] = 1;
+	UNPROTECT(1);
+
+	nitems = dims[0];
+	if (nitems == 0)
+	{
+		*isnull = true;
+		return (Datum) 0;
+	}
+
+	dvalues = (Datum *) palloc(nitems * sizeof(Datum));
+	nulls = (bool *) palloc(nitems * sizeof(bool));
+	PROTECT(obj =  AS_CHARACTER(rval));
+
+	for (i = 0; i < nitems; i++)
+	{
+		value = CHAR(STRING_ELT(obj, i));
+
+		if (STRING_ELT(obj, i) == NA_STRING || value == NULL)
+		{
+			nulls[i] = TRUE;
+			have_nulls = TRUE;
+		}
+		else
+		{
+			nulls[i] = FALSE;
+			dvalues[i] = FunctionCall3(&in_func,
+										CStringGetDatum(value),
+										(Datum) 0,
+										Int32GetDatum(-1));
+		}
+	}
+	UNPROTECT(1);
+
+	if (!have_nulls)
+		array = construct_md_array(dvalues, NULL, ndims, dims, lbs,
+									typelem, typlen, typbyval, typalign);
+	else
+		array = construct_md_array(dvalues, nulls, ndims, dims, lbs,
+									typelem, typlen, typbyval, typalign);
+
+	dvalue = PointerGetDatum(array);
+
+	return dvalue;
+}
+
 static Datum
 get_md_array_datum(SEXP rval, int ndims, plr_function *function, int col, bool *isnull)
 {

pg_rsupport.c

@@ -330,7 +330,7 @@ plr_SPI_prepare(SEXP rsql, SEXP rargtypes)
 
 			get_type_io_data(typeids[i], IOFunc_input, &typlen, &typbyval,
 							 &typalign, &typdelim, &typelem, &typinput);
-			typelems[i] = typelem;
+			typelems[i] = get_element_type(typeids[i]);
 
 			MemoryContextSwitchTo(oldcontext);
 
@@ -455,6 +455,7 @@ plr_SPI_execp(SEXP rsaved_plan, SEXP rargvalues)
 	void			   *saved_plan = plan_desc->saved_plan;
 	int					nargs = plan_desc->nargs;
 	Oid				   *typeids = plan_desc->typeids;
+	Oid				   *typelems = plan_desc->typelems;
 	FmgrInfo		   *typinfuncs = plan_desc->typinfuncs;
 	int					i;
 	Datum			   *argvalues = NULL;
@@ -491,7 +492,7 @@ plr_SPI_execp(SEXP rsaved_plan, SEXP rargvalues)
 	{
 		PROTECT(obj = VECTOR_ELT(rargvalues, i));
 
-		argvalues[i] = get_scalar_datum(obj, typeids[i], typinfuncs[i], &isnull);
+		argvalues[i] = get_datum(obj, typeids[i], typelems[i], typinfuncs[i], &isnull);
 		if (!isnull)
 			nulls[i] = ' ';
 		else

plr.c

@@ -1082,8 +1082,8 @@ do_compile(FunctionCallInfo fcinfo,
 				function->result_elem = InvalidOid;
 
 			/*
-			* if we have an array type, get the element type's in_func
-			*/
+			 * if we have an array type, get the element type's in_func
+			 */
 			if (function->result_elem != InvalidOid)
 			{
 				int16		typlen;

plr.h

@@ -480,6 +480,7 @@ extern SEXP pg_scalar_get_r(Datum dvalue, Oid arg_typid, FmgrInfo arg_out_func);
 extern SEXP pg_array_get_r(Datum dvalue, FmgrInfo out_func, int typlen, bool typbyval, char typalign);
 extern SEXP pg_tuple_get_r_frame(int ntuples, HeapTuple *tuples, TupleDesc tupdesc);
 extern Datum r_get_pg(SEXP rval, plr_function *function, FunctionCallInfo fcinfo);
+extern Datum get_datum(SEXP rval, Oid typid, Oid typelem, FmgrInfo in_func, bool *isnull);
 extern Datum get_scalar_datum(SEXP rval, Oid result_typ, FmgrInfo result_in_func, bool *isnull);
 
 /* Postgres support functions installed into the R interpreter */