Re: suspicious pointer/integer coersion - Mailing list pgsql-hackers

Andrew Dunstan wrote:

>
>
> Andrew Dunstan wrote:
>
>>
>>
>>
>>
>> Looking further ... we already do this implicitly for prodesc in the
>> call handler - we would just need to do the same thing for per-call
>> structures and divorce them from prodesc, which can be repeated on
>> the implicit stack.
>>
>> I'll work on that - changes should be quite small.
>>
>
> Attached is a patch that fixes (I hope) both a recently introduced
> problem with recursion and a problem with array returns that became
> evident as a result of not throwing away non-fatal warnings (thanks to
> David Fetter for noticing this). Regression test updates to include
> both cases are included in the patch.
>
> I will start looking at putting the procedure descriptors in a dynahash.
>
>

and here's the patch this time.

cheers


andrew
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();