From 5aeefad98f7929355a231e5782a19402adc583e3 Mon Sep 17 00:00:00 2001
From: Michael Paquier <michael@otacoo.com>
Date: Wed, 22 Jul 2015 15:39:44 +0900
Subject: [PATCH 2/3] Replace use of malloc by an internal memory context in
 plperl

This makes the code more flexible by using the internal memory context
infrastructure instead of a system-level memory call.
---
 src/pl/plperl/plperl.c | 54 ++++++++++++++++++++++++--------------------------
 1 file changed, 26 insertions(+), 28 deletions(-)

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 78baaac..327d262 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -108,6 +108,7 @@ typedef struct plperl_proc_desc
 	TransactionId fn_xmin;		/* xmin/TID of procedure's pg_proc tuple */
 	ItemPointerData fn_tid;
 	int			refcount;		/* reference count of this struct */
+	MemoryContext memcxt;		/* memory context where this lives */
 	SV		   *reference;		/* CODE reference for Perl sub */
 	plperl_interp_desc *interp; /* interpreter it's created in */
 	bool		fn_readonly;	/* is function readonly (not volatile)? */
@@ -2588,18 +2589,16 @@ free_plperl_function(plperl_proc_desc *prodesc)
 		SvREFCNT_dec(prodesc->reference);
 		activate_interpreter(oldinterp);
 	}
-	/* Get rid of what we conveniently can of our own structs */
-	/* (FmgrInfo subsidiary info will get leaked ...) */
-	if (prodesc->proname)
-		free(prodesc->proname);
-	list_free(prodesc->trftypes);
-	free(prodesc);
+
+	/* Finish destroying this data */
+	MemoryContextDelete(prodesc->memcxt);
 }
 
 
 static plperl_proc_desc *
 compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 {
+	volatile MemoryContext plan_cxt = NULL;
 	HeapTuple	procTup;
 	Form_pg_proc procStruct;
 	plperl_proc_key proc_key;
@@ -2608,6 +2607,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 	int			i;
 	plperl_interp_desc *oldinterp = plperl_active_interp;
 	ErrorContextCallback plperl_error_context;
+	MemoryContext oldcontext = CurrentMemoryContext;
 
 	/* We'll need the pg_proc tuple in any case... */
 	procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid));
@@ -2662,38 +2662,33 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 
 		/************************************************************
 		 * Allocate a new procedure description block
+		 *
+		 * struct prodesc and subsidiary data all live in plan_cxt.
 		 ************************************************************/
-		prodesc = (plperl_proc_desc *) malloc(sizeof(plperl_proc_desc));
-		if (prodesc == NULL)
-			ereport(ERROR,
-					(errcode(ERRCODE_OUT_OF_MEMORY),
-					 errmsg("out of memory")));
-		/* Initialize all fields to 0 so free_plperl_function is safe */
-		MemSet(prodesc, 0, sizeof(plperl_proc_desc));
-
+		plan_cxt = AllocSetContextCreate(TopMemoryContext,
+										 "PL/Perl compile",
+										 ALLOCSET_SMALL_MINSIZE,
+										 ALLOCSET_SMALL_INITSIZE,
+										 ALLOCSET_SMALL_MAXSIZE);
+		MemoryContextSwitchTo(plan_cxt);
+		prodesc = (plperl_proc_desc *) palloc0(sizeof(plperl_proc_desc));
 		prodesc->proname = strdup(NameStr(procStruct->proname));
-		if (prodesc->proname == NULL)
-		{
-			free_plperl_function(prodesc);
-			ereport(ERROR,
-					(errcode(ERRCODE_OUT_OF_MEMORY),
-					 errmsg("out of memory")));
-		}
+		MemoryContextSwitchTo(oldcontext);
+		prodesc->memcxt = plan_cxt;
 		prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data);
 		prodesc->fn_tid = procTup->t_self;
 
+
 		/* Remember if function is STABLE/IMMUTABLE */
 		prodesc->fn_readonly =
 			(procStruct->provolatile != PROVOLATILE_VOLATILE);
 
 		{
-			MemoryContext oldcxt;
-
 			protrftypes_datum = SysCacheGetAttr(PROCOID, procTup,
 										  Anum_pg_proc_protrftypes, &isnull);
-			oldcxt = MemoryContextSwitchTo(TopMemoryContext);
+			MemoryContextSwitchTo(plan_cxt);
 			prodesc->trftypes = isnull ? NIL : oid_array_to_list(protrftypes_datum);
-			MemoryContextSwitchTo(oldcxt);
+			MemoryContextSwitchTo(oldcontext);
 		}
 
 		/************************************************************
@@ -2762,7 +2757,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 			prodesc->fn_retisarray =
 				(typeStruct->typlen == -1 && typeStruct->typelem);
 
-			perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
+			fmgr_info_cxt(typeStruct->typinput,
+						  &(prodesc->result_in_func),
+						  plan_cxt);
 			prodesc->result_typioparam = getTypeIOParam(typeTup);
 
 			ReleaseSysCache(typeTup);
@@ -2804,8 +2801,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 				else
 				{
 					prodesc->arg_is_rowtype[i] = false;
-					perm_fmgr_info(typeStruct->typoutput,
-								   &(prodesc->arg_out_func[i]));
+					fmgr_info_cxt(typeStruct->typoutput,
+								  &(prodesc->arg_out_func[i]),
+								  plan_cxt);
 				}
 
 				/* Identify array attributes */
-- 
2.4.6