diff --git a/pg_conversion.c b/pg_conversion.c index a33a85b6..f296460e 100755 --- a/pg_conversion.c +++ b/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) { diff --git a/pg_rsupport.c b/pg_rsupport.c index 80bb0dc2..342eae0c 100755 --- a/pg_rsupport.c +++ b/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 diff --git a/plr.c b/plr.c index d6015668..0a75f309 100755 --- a/plr.c +++ b/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; diff --git a/plr.h b/plr.h index fafab28b..83e97bf0 100755 --- a/plr.h +++ b/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 */