src/pl/plperl/expected/plperl_elog_1.out

   1 -- test warnings and errors from plperl
   2 create or replace function perl_elog(text) returns void language plperl as $$
   3
   4   my $msg = shift;
   5   elog(NOTICE,$msg);
   6
   7 $$;
   8 select perl_elog('explicit elog');
   9 NOTICE:  explicit elog
  10  perl_elog
  11 -----------
  12
  13 (1 row)
  14
  15 create or replace function perl_warn(text) returns void language plperl as $$
  16
  17   my $msg = shift;
  18   warn($msg);
  19
  20 $$;
  21 select perl_warn('implicit elog via warn');
  22 WARNING:  implicit elog via warn at line 4.
  23  perl_warn
  24 -----------
  25
  26 (1 row)
  27
  28 -- test strict mode on/off
  29 SET plperl.use_strict = true;
  30 create or replace function uses_global() returns text language plperl as $$
  31
  32   $global = 1;
  33   $other_global = 2;
  34   return 'uses_global worked';
  35
  36 $$;
  37 ERROR:  Global symbol "$global" requires explicit package name (did you forget to declare "my $global"?) at line 3.
  38 Global symbol "$other_global" requires explicit package name (did you forget to declare "my $other_global"?) at line 4.
  39 CONTEXT:  compilation of PL/Perl function "uses_global"
  40 select uses_global();
  41 ERROR:  function uses_global() does not exist
  42 LINE 1: select uses_global();
  43                ^
  44 HINT:  No function matches the given name and argument types. You might need to add explicit type casts.
  45 SET plperl.use_strict = false;
  46 create or replace function uses_global() returns text language plperl as $$
  47
  48   $global = 1;
  49   $other_global=2;
  50   return 'uses_global worked';
  51
  52 $$;
  53 select uses_global();
  54     uses_global
  55 --------------------
  56  uses_global worked
  57 (1 row)
  58
  59 -- make sure we don't choke on readonly values
  60 do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
  61 NOTICE:  0
  62 -- test recovery after "die"
  63 create or replace function just_die() returns void language plperl AS $$
  64 die "just die";
  65 $$;
  66 select just_die();
  67 ERROR:  just die at line 2.
  68 CONTEXT:  PL/Perl function "just_die"
  69 create or replace function die_caller() returns int language plpgsql as $$
  70 BEGIN
  71   BEGIN
  72     PERFORM just_die();
  73   EXCEPTION WHEN OTHERS THEN
  74     RAISE NOTICE 'caught die';
  75   END;
  76   RETURN 1;
  77 END;
  78 $$;
  79 select die_caller();
  80 NOTICE:  caught die
  81  die_caller
  82 ------------
  83           1
  84 (1 row)
  85
  86 create or replace function indirect_die_caller() returns int language plperl as $$
  87 my $prepared = spi_prepare('SELECT die_caller() AS fx');
  88 my $a = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
  89 my $b = spi_exec_prepared($prepared)->{rows}->[0]->{fx};
  90 return $a + $b;
  91 $$;
  92 select indirect_die_caller();
  93 NOTICE:  caught die
  94 NOTICE:  caught die
  95  indirect_die_caller
  96 ---------------------
  97                    2
  98 (1 row)
  99
 100 -- Test non-ASCII error messages
 101 --
 102 -- Note: this test case is known to fail if the database encoding is
 103 -- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to
 104 -- U+00A0 (no-break space) in those encodings.  However, testing with
 105 -- plain ASCII data would be rather useless, so we must live with that.
 106 SET client_encoding TO UTF8;
 107 create or replace function error_with_nbsp() returns void language plperl as $$
 108   elog(ERROR, "this message contains a no-break space");
 109 $$;
 110 select error_with_nbsp();
 111 ERROR:  this message contains a no-break space at line 2.
 112 CONTEXT:  PL/Perl function "error_with_nbsp"