Thread: plperl SRF sanity check fix

The attached patch moves a plperl sanity check into the correct
position. Performing the check in the existing position allows the call
to go through to perl first, possibly resulting in a SEGV.

cheers

andrew
Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.79
diff -c -r1.79 plperl.c
*** plperl.c    3 Jul 2005 21:56:16 -0000    1.79
--- plperl.c    6 Jul 2005 15:46:52 -0000
***************
*** 850,855 ****
--- 850,867 ----
      prodesc->tuple_store = 0;
      prodesc->tuple_desc = 0;

+     rsi = (ReturnSetInfo *)fcinfo->resultinfo;
+
+     if (prodesc->fn_retisset && (!rsi || !IsA(rsi, ReturnSetInfo) ||
+             (rsi->allowedModes & SFRM_Materialize) == 0 ||
+                                  rsi->expectedDesc == NULL))
+     {
+         ereport(ERROR,
+                 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                  errmsg("set-valued function called in context that "
+                         "cannot accept a set")));
+     }
+
      perlret = plperl_call_perl_func(prodesc, fcinfo);

      /************************************************************
***************
*** 861,879 ****
      if (SPI_finish() != SPI_OK_FINISH)
          elog(ERROR, "SPI_finish() failed");

!     rsi = (ReturnSetInfo *)fcinfo->resultinfo;
!
!     if (prodesc->fn_retisset) {
!         if (!rsi || !IsA(rsi, ReturnSetInfo) ||
!             (rsi->allowedModes & SFRM_Materialize) == 0 ||
!             rsi->expectedDesc == NULL)
!         {
!             ereport(ERROR,
!                     (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
!                      errmsg("set-valued function called in context that "
!                             "cannot accept a set")));
!         }
!
          /* If the Perl function returned an arrayref, we pretend that it
           * called return_next() for each element of the array, to handle
           * old SRFs that didn't know about return_next(). Any other sort
--- 873,880 ----
      if (SPI_finish() != SPI_OK_FINISH)
          elog(ERROR, "SPI_finish() failed");

!     if (prodesc->fn_retisset)
!     {
          /* If the Perl function returned an arrayref, we pretend that it
           * called return_next() for each element of the array, to handle
           * old SRFs that didn't know about return_next(). Any other sort

Andrew Dunstan wrote:
>
> The attached patch moves a plperl sanity check into the correct
> position. Performing the check in the existing position allows the call
> to go through to perl first, possibly resulting in a SEGV.

OK, patch applied.  Your version didn't apply cleanly so I just moved
the block manually.

--
  Bruce Momjian                        |  http://candle.pha.pa.us
  pgman@candle.pha.pa.us               |  (610) 359-1001
  +  If your life is a hard drive,     |  13 Roberts Road
  +  Christ can be your backup.        |  Newtown Square, Pennsylvania 19073
Index: src/pl/plperl/plperl.c
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.86
diff -c -c -r1.86 plperl.c
*** src/pl/plperl/plperl.c    12 Jul 2005 20:35:42 -0000    1.86
--- src/pl/plperl/plperl.c    12 Aug 2005 20:45:56 -0000
***************
*** 921,926 ****
--- 921,936 ----
      plperl_current_tuple_store = 0;
      plperl_current_tuple_desc = 0;

+     if (!rsi || !IsA(rsi, ReturnSetInfo) ||
+         (rsi->allowedModes & SFRM_Materialize) == 0 ||
+         rsi->expectedDesc == NULL)
+     {
+         ereport(ERROR,
+                 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                  errmsg("set-valued function called in context that "
+                         "cannot accept a set")));
+     }
+
      perlret = plperl_call_perl_func(prodesc, fcinfo);

      /************************************************************
***************
*** 936,951 ****

      if (prodesc->fn_retisset)
      {
-         if (!rsi || !IsA(rsi, ReturnSetInfo) ||
-             (rsi->allowedModes & SFRM_Materialize) == 0 ||
-             rsi->expectedDesc == NULL)
-         {
-             ereport(ERROR,
-                     (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
-                      errmsg("set-valued function called in context that "
-                             "cannot accept a set")));
-         }
-
          /* If the Perl function returned an arrayref, we pretend that it
           * called return_next() for each element of the array, to handle
           * old SRFs that didn't know about return_next(). Any other sort
--- 946,951 ----