suspicious pointer/integer coersion

Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.84
diff -c -r1.84 plperl.c
*** plperl.c	10 Jul 2005 16:13:13 -0000	1.84
--- plperl.c	11 Jul 2005 13:08:26 -0000
***************
*** 90,98 ****
  	FmgrInfo	arg_out_func[FUNC_MAX_ARGS];
  	bool		arg_is_rowtype[FUNC_MAX_ARGS];
  	SV		   *reference;
- 	FunctionCallInfo caller_info;
- 	Tuplestorestate *tuple_store;
- 	TupleDesc tuple_desc;
  } plperl_proc_desc;
  
  
--- 90,95 ----
***************
*** 106,113 ****
  
  static bool plperl_use_strict = false;
  
! /* this is saved and restored by plperl_call_handler */
  static plperl_proc_desc *plperl_current_prodesc = NULL;
  
  /**********************************************************************
   * Forward declarations
--- 103,113 ----
  
  static bool plperl_use_strict = false;
  
! /* these are saved and restored by plperl_call_handler */
  static plperl_proc_desc *plperl_current_prodesc = NULL;
+ static FunctionCallInfo plperl_current_caller_info;
+ static Tuplestorestate *plperl_current_tuple_store;
+ static TupleDesc plperl_current_tuple_desc;
  
  /**********************************************************************
   * Forward declarations
***************
*** 577,586 ****
--- 577,592 ----
  {
  	Datum retval;
  	plperl_proc_desc *save_prodesc;
+ 	FunctionCallInfo save_caller_info;
+ 	Tuplestorestate *save_tuple_store;
+ 	TupleDesc save_tuple_desc;
  
  	plperl_init_all();
  
  	save_prodesc = plperl_current_prodesc;
+ 	save_caller_info = plperl_current_caller_info;
+ 	save_tuple_store = plperl_current_tuple_store;
+ 	save_tuple_desc = plperl_current_tuple_desc;
  
  	PG_TRY();
  	{
***************
*** 592,602 ****
--- 598,614 ----
  	PG_CATCH();
  	{
  		plperl_current_prodesc = save_prodesc;
+ 		plperl_current_caller_info = save_caller_info;
+ 		plperl_current_tuple_store = save_tuple_store;
+ 		plperl_current_tuple_desc = save_tuple_desc;
  		PG_RE_THROW();
  	}
  	PG_END_TRY();
  
  	plperl_current_prodesc = save_prodesc;
+ 	plperl_current_caller_info = save_caller_info;
+ 	plperl_current_tuple_store = save_tuple_store;
+ 	plperl_current_tuple_desc = save_tuple_desc;
  
  	return retval;
  }
***************
*** 897,902 ****
--- 909,915 ----
  	SV		   *perlret;
  	Datum		retval;
  	ReturnSetInfo *rsi;
+         SV* array_ret = NULL;
  
  	if (SPI_connect() != SPI_OK_CONNECT)
  		elog(ERROR, "could not connect to SPI manager");
***************
*** 904,912 ****
  	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
  
  	plperl_current_prodesc = prodesc;
! 	prodesc->caller_info = fcinfo;
! 	prodesc->tuple_store = 0;
! 	prodesc->tuple_desc = 0;
  
  	perlret = plperl_call_perl_func(prodesc, fcinfo);
  
--- 917,925 ----
  	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
  
  	plperl_current_prodesc = prodesc;
! 	plperl_current_caller_info = fcinfo;
! 	plperl_current_tuple_store = 0;
! 	plperl_current_tuple_desc = 0;
  
  	perlret = plperl_call_perl_func(prodesc, fcinfo);
  
***************
*** 958,967 ****
  		}
  
  		rsi->returnMode = SFRM_Materialize;
! 		if (prodesc->tuple_store) 
  		{
! 			rsi->setResult = prodesc->tuple_store;
! 			rsi->setDesc = prodesc->tuple_desc;
  		}
  		retval = (Datum)0;
  	}
--- 971,980 ----
  		}
  
  		rsi->returnMode = SFRM_Materialize;
! 		if (plperl_current_tuple_store) 
  		{
! 			rsi->setResult = plperl_current_tuple_store;
! 			rsi->setDesc = plperl_current_tuple_desc;
  		}
  		retval = (Datum)0;
  	}
***************
*** 1006,1012 ****
  	{
          /* Return a perl string converted to a Datum */
          char *val;
-         SV* array_ret;
   
  
          if (prodesc->fn_retisarray && SvTYPE(SvRV(perlret)) == SVt_PVAV)
--- 1019,1024 ----
***************
*** 1024,1030 ****
  							   Int32GetDatum(-1));
  	}
  
! 	SvREFCNT_dec(perlret);
  	return retval;
  }
  
--- 1036,1044 ----
  							   Int32GetDatum(-1));
  	}
  
! 	if (array_ret == NULL)
! 	  SvREFCNT_dec(perlret);
! 
  	return retval;
  }
  
***************
*** 1526,1532 ****
  plperl_return_next(SV *sv)
  {
  	plperl_proc_desc *prodesc = plperl_current_prodesc;
! 	FunctionCallInfo fcinfo = prodesc->caller_info;
  	ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo;
  	MemoryContext cxt;
  	HeapTuple tuple;
--- 1540,1546 ----
  plperl_return_next(SV *sv)
  {
  	plperl_proc_desc *prodesc = plperl_current_prodesc;
! 	FunctionCallInfo fcinfo = plperl_current_caller_info;
  	ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo;
  	MemoryContext cxt;
  	HeapTuple tuple;
***************
*** 1553,1560 ****
  
  	cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
  
! 	if (!prodesc->tuple_store)
! 		prodesc->tuple_store = tuplestore_begin_heap(true, false, work_mem);
  
  	if (prodesc->fn_retistuple)
  	{
--- 1567,1575 ----
  
  	cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
  
! 	if (!plperl_current_tuple_store)
! 		plperl_current_tuple_store = 
! 			tuplestore_begin_heap(true, false, work_mem);
  
  	if (prodesc->fn_retistuple)
  	{
***************
*** 1590,1599 ****
  		tuple = heap_form_tuple(tupdesc, &ret, &isNull);
  	}
  
! 	if (!prodesc->tuple_desc)
! 		prodesc->tuple_desc = tupdesc;
  
! 	tuplestore_puttuple(prodesc->tuple_store, tuple);
  	heap_freetuple(tuple);
  	MemoryContextSwitchTo(cxt);
  }
--- 1605,1614 ----
  		tuple = heap_form_tuple(tupdesc, &ret, &isNull);
  	}
  
! 	if (!plperl_current_tuple_desc)
! 		plperl_current_tuple_desc = tupdesc;
  
! 	tuplestore_puttuple(plperl_current_tuple_store, tuple);
  	heap_freetuple(tuple);
  	MemoryContextSwitchTo(cxt);
  }
Index: expected/plperl.out
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/expected/plperl.out,v
retrieving revision 1.3
diff -c -r1.3 plperl.out
*** expected/plperl.out	10 Jul 2005 15:19:43 -0000	1.3
--- expected/plperl.out	11 Jul 2005 13:08:26 -0000
***************
*** 367,369 ****
--- 367,422 ----
               2
  (2 rows)
  
+ ---
+ --- Test recursion via SPI
+ ---
+ CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl
+ AS $$
+ 
+   my $i = shift;
+   foreach my $x (1..$i)
+   {
+     return_next "hello $x";
+   }
+   if ($i > 2)
+   {
+     my $z = $i-1;
+     my $cursor = spi_query("select * from recurse($z)");
+     while (defined(my $row = spi_fetchrow($cursor)))
+     {
+       return_next "recurse $i: $row->{recurse}";
+     }
+   }
+   return undef;
+ 
+ $$;
+ SELECT * FROM recurse(2);
+  recurse 
+ ---------
+  hello 1
+  hello 2
+ (2 rows)
+ 
+ SELECT * FROM recurse(3);
+       recurse       
+ --------------------
+  hello 1
+  hello 2
+  hello 3
+  recurse 3: hello 1
+  recurse 3: hello 2
+ (5 rows)
+ 
+ ---
+ --- Test arrary return
+ ---
+ CREATE OR REPLACE FUNCTION  array_of_text() RETURNS TEXT[][] 
+ LANGUAGE plperl as $$ 
+     return [['a"b','c,d'],['e\\f','g']]; 
+ $$;
+ SELECT array_of_text(); 
+         array_of_text        
+ -----------------------------
+  {{"a\"b","c,d"},{"e\\f",g}}
+ (1 row)
+ 
Index: sql/plperl.sql
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/sql/plperl.sql,v
retrieving revision 1.3
diff -c -r1.3 plperl.sql
*** sql/plperl.sql	10 Jul 2005 15:19:43 -0000	1.3
--- sql/plperl.sql	11 Jul 2005 13:08:26 -0000
***************
*** 260,262 ****
--- 260,303 ----
  return;
  $$ LANGUAGE plperl;
  SELECT * from perl_spi_func();
+ 
+ 
+ ---
+ --- Test recursion via SPI
+ ---
+ 
+ 
+ CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl
+ AS $$
+ 
+   my $i = shift;
+   foreach my $x (1..$i)
+   {
+     return_next "hello $x";
+   }
+   if ($i > 2)
+   {
+     my $z = $i-1;
+     my $cursor = spi_query("select * from recurse($z)");
+     while (defined(my $row = spi_fetchrow($cursor)))
+     {
+       return_next "recurse $i: $row->{recurse}";
+     }
+   }
+   return undef;
+ 
+ $$;
+ 
+ SELECT * FROM recurse(2);
+ SELECT * FROM recurse(3);
+ 
+ 
+ ---
+ --- Test arrary return
+ ---
+ CREATE OR REPLACE FUNCTION  array_of_text() RETURNS TEXT[][] 
+ LANGUAGE plperl as $$ 
+     return [['a"b','c,d'],['e\\f','g']]; 
+ $$;
+ 
+ SELECT array_of_text();