[PATCHES] PL/Perl regression tests with use_strict

[Michael Fuhr]

The attached patch allows the PL/Perl regression tests to pass when
use_strict is enabled.  I've also attached a variant of plperl_elog.out
to account for an elog() message that shows a different line number
when run under use_strict.

-- 
Michael Fuhr

Index: src/pl/plperl/sql/plperl.sql
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/sql/plperl.sql,v
retrieving revision 1.4
diff -c -r1.4 plperl.sql
*** src/pl/plperl/sql/plperl.sql        12 Jul 2005 01:16:22 -0000      1.4
--- src/pl/plperl/sql/plperl.sql        20 Aug 2005 19:38:39 -0000
***************
*** 240,246 ****
  --
  
  CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$
! $i = 0;
  for ("World", "PostgreSQL", "PL/Perl") {
      return_next({f1=>++$i, f2=>'Hello', f3=>$_});
  }
--- 240,246 ----
  --
  
  CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$
! my $i = 0;
  for ("World", "PostgreSQL", "PL/Perl") {
      return_next({f1=>++$i, f2=>'Hello', f3=>$_});
  }
***************
*** 253,260 ****
  --
  
  CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
! $x = spi_query("select 1 as a union select 2 as a");
! while (defined ($y = spi_fetchrow($x))) {
      return_next($y->{a});
  }
  return;
--- 253,260 ----
  --
  
  CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
! my $x = spi_query("select 1 as a union select 2 as a");
! while (defined (my $y = spi_fetchrow($x))) {
      return_next($y->{a});
  }
  return;
Index: src/pl/plperl/expected/plperl.out
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/expected/plperl.out,v
retrieving revision 1.4
diff -c -r1.4 plperl.out
*** src/pl/plperl/expected/plperl.out   12 Jul 2005 01:16:22 -0000      1.4
--- src/pl/plperl/expected/plperl.out   20 Aug 2005 19:38:39 -0000
***************
*** 336,342 ****
  -- Test return_next
  --
  CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$
! $i = 0;
  for ("World", "PostgreSQL", "PL/Perl") {
      return_next({f1=>++$i, f2=>'Hello', f3=>$_});
  }
--- 336,342 ----
  -- Test return_next
  --
  CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$
! my $i = 0;
  for ("World", "PostgreSQL", "PL/Perl") {
      return_next({f1=>++$i, f2=>'Hello', f3=>$_});
  }
***************
*** 354,361 ****
  -- Test spi_query/spi_fetchrow
  --
  CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
! $x = spi_query("select 1 as a union select 2 as a");
! while (defined ($y = spi_fetchrow($x))) {
      return_next($y->{a});
  }
  return;
--- 354,361 ----
  -- Test spi_query/spi_fetchrow
  --
  CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$
! my $x = spi_query("select 1 as a union select 2 as a");
! while (defined (my $y = spi_fetchrow($x))) {
      return_next($y->{a});
  }
  return;

-- test warnings and errors from plperl
create or replace function perl_elog(text) returns void language plperl as $$

  my $msg = shift;
  elog(NOTICE,$msg);

$$;
select perl_elog('explicit elog');
NOTICE:  explicit elog
 perl_elog 
-----------
 
(1 row)

create or replace function perl_warn(text) returns void language plperl as $$

  my $msg = shift;
  warn($msg);

$$;
select perl_warn('implicit elog via warn');
NOTICE:  implicit elog via warn at (eval 9) line 4.

 perl_warn 
-----------
 
(1 row)


---------------------------(end of broadcast)---------------------------
TIP 9: In versions below 8.0, the planner will ignore your desire to
       choose an index scan if your joining column's datatypes do not
       match