Remove ill-considered suppression of gcc warnings in plperl, and fix

some of the bugs exposed thereby.  The remaining 'might be used uninitialized'
warnings look like live bugs, but I am not familiar enough with Perl/C hacking
to tell how to fix them.

2 files changed, 24 insertions, 30 deletions

diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index d1a2ac6fe78..2a5392405cb 100644
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -1,5 +1,5 @@
 # Makefile for PL/Perl
-# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.16 2004/10/07 19:01:09 momjian Exp $
+# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.17 2004/11/17 21:23:36 tgl Exp $
 
 subdir = src/pl/plperl
 top_builddir = ../../..
@@ -16,11 +16,6 @@ endif
 # to work without, we have to skip it.
 ifneq (,$(findstring yes, $(shared_libperl)$(allow_nonpic_in_shlib)))
 
-# The code isn't clean with regard to these warnings.
-ifeq ($(GCC),yes)
-override CFLAGS := $(filter-out -Wall -Wmissing-declarations -Wmissing-prototypes, $(CFLAGS))
-endif
-
 ifeq ($(PORTNAME), win32)
 perl_archlibexp := $(subst \,/,$(perl_archlibexp))
 perl_privlibexp := $(subst \,/,$(perl_privlibexp))
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 8800fb4f649..45a4f7aff76 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.56 2004/11/16 22:05:22 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.57 2004/11/17 21:23:36 tgl Exp $
  *
  **********************************************************************/
 
@@ -116,6 +116,8 @@ static void plperl_init_interp(void);
 Datum		plperl_call_handler(PG_FUNCTION_ARGS);
 void		plperl_init(void);
 
+HV		   *plperl_spi_exec(char *query, int limit);
+
 static Datum plperl_func_handler(PG_FUNCTION_ARGS);
 
 static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
@@ -685,7 +687,7 @@ plperl_create_sub(char *s, bool trusted)
 
 	if (SvTRUE(ERRSV))
 	{
-		POPs;
+		(void) POPs;
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
@@ -821,7 +823,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
 
 	if (SvTRUE(ERRSV))
 	{
-		POPs;
+		(void) POPs;
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
@@ -872,7 +874,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S
 
 	if (SvTRUE(ERRSV))
 	{
-		POPs;
+		(void) POPs;
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
@@ -935,7 +937,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 	if (!(perlret && SvOK(perlret) && SvTYPE(perlret) != SVt_NULL))
 	{
 		/* return NULL if Perl code returned undef */
-		retval = (Datum) 0;
 		fcinfo->isnull = true;
 	}
 
@@ -945,29 +946,25 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 	if (prodesc->fn_retistuple && perlret && SvTYPE(perlret) != SVt_RV)
 		elog(ERROR, "plperl: composite-returning function must return a reference");
 
+	if (prodesc->fn_retisset && !fcinfo->resultinfo)
+		ereport(ERROR,
+				(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+				 errmsg("set-valued function called in context that cannot accept a set")));
+
 	if (prodesc->fn_retistuple && fcinfo->resultinfo)	/* set of tuples */
 	{
 		/* SRF support */
 		HV		   *ret_hv;
 		AV		   *ret_av;
-
 		FuncCallContext *funcctx;
 		int			call_cntr;
 		int			max_calls;
 		TupleDesc	tupdesc;
-		TupleTableSlot *slot;
 		AttInMetadata *attinmeta;
-		bool		isset = 0;
+		bool		isset;
 		char	  **values = NULL;
 		ReturnSetInfo *rsinfo = (ReturnSetInfo *) fcinfo->resultinfo;
 
-		if (prodesc->fn_retisset && !rsinfo)
-			ereport(ERROR,
-					(errcode(ERRCODE_SYNTAX_ERROR),
-					 errmsg("returning a composite type is not allowed in this context"),
-					 errhint("This function is intended for use in the FROM clause.")));
-
-
 		isset = plperl_is_set(perlret);
 
 		if (SvTYPE(SvRV(perlret)) == SVt_PVHV)
@@ -1007,8 +1004,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 				av_store(g_column_keys, i + 1,
 						 newSVpv(SPI_fname(tupdesc, i+1), 0));
 
-			slot = TupleDescGetSlot(tupdesc);
-			funcctx->slot = slot;
 			attinmeta = TupleDescGetAttInMetadata(tupdesc);
 			funcctx->attinmeta = attinmeta;
 			MemoryContextSwitchTo(oldcontext);
@@ -1017,8 +1012,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		funcctx = SRF_PERCALL_SETUP();
 		call_cntr = funcctx->call_cntr;
 		max_calls = funcctx->max_calls;
-		slot = funcctx->slot;
 		attinmeta = funcctx->attinmeta;
+		tupdesc = attinmeta->tupdesc;
 
 		if (call_cntr < max_calls)
 		{
@@ -1065,7 +1060,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 				}
 			}
 			tuple = BuildTupleFromCStrings(attinmeta, values);
-			result = TupleGetDatum(slot, tuple);
+			result = HeapTupleGetDatum(tuple);
 			SRF_RETURN_NEXT(funcctx, result);
 		}
 		else
@@ -1100,17 +1095,19 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 			svp = av_fetch(array, funcctx->call_cntr, FALSE);
 
 			if (SvTYPE(*svp) != SVt_NULL)
+			{
+				fcinfo->isnull = false;
 				result = FunctionCall3(&prodesc->result_in_func,
 									   PointerGetDatum(SvPV(*svp, PL_na)),
 							ObjectIdGetDatum(prodesc->result_typioparam),
 									   Int32GetDatum(-1));
+			}
 			else
 			{
 				fcinfo->isnull = true;
 				result = (Datum) 0;
 			}
 			SRF_RETURN_NEXT(funcctx, result);
-			fcinfo->isnull = false;
 		}
 		else
 		{
@@ -1121,8 +1118,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 	}
 	else if (!fcinfo->isnull)	/* non-null singleton */
 	{
-
-
 		if (prodesc->fn_retistuple)		/* singleton perl hash to Datum */
 		{
 			TupleDesc	td = lookup_rowtype_tupdesc(prodesc->ret_oid, (int32) -1);
@@ -1153,7 +1148,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 			attinmeta = TupleDescGetAttInMetadata(td);
 			tup = BuildTupleFromCStrings(attinmeta, values);
 			retval = HeapTupleGetDatum(tup);
-
 		}
 		else
 			/* perl string to Datum */
@@ -1161,8 +1155,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 								   PointerGetDatum(SvPV(perlret, PL_na)),
 							ObjectIdGetDatum(prodesc->result_typioparam),
 								   Int32GetDatum(-1));
-
 	}
+	else		/* null singleton */
+		retval = (Datum) 0;
 
 	SvREFCNT_dec(perlret);
 	return retval;
@@ -1220,6 +1215,8 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
 			retval = (Datum) trigdata->tg_newtuple;
 		else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
 			retval = (Datum) trigdata->tg_trigtuple;
+		else
+			retval = (Datum) 0;	/* can this happen? */
 	}
 	else
 	{
@@ -1256,6 +1253,8 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
 			}
 			retval = PointerGetDatum(trv);
 		}
+		else
+			retval = (Datum) 0;
 	}
 
 	SvREFCNT_dec(perlret);