|
| 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 | +CONTEXT: PL/Perl function "perl_elog" |
| 11 | + perl_elog |
| 12 | +----------- |
| 13 | + |
| 14 | +(1 row) |
| 15 | + |
| 16 | +create or replace function perl_warn(text) returns void language plperl as $$ |
| 17 | + |
| 18 | + my $msg = shift; |
| 19 | + warn($msg); |
| 20 | + |
| 21 | +$$; |
| 22 | +select perl_warn('implicit elog via warn'); |
| 23 | +WARNING: implicit elog via warn at line 4. |
| 24 | +CONTEXT: PL/Perl function "perl_warn" |
| 25 | + perl_warn |
| 26 | +----------- |
| 27 | + |
| 28 | +(1 row) |
| 29 | + |
| 30 | +-- test strict mode on/off |
| 31 | +SET plperl.use_strict = true; |
| 32 | +create or replace function uses_global() returns text language plperl as $$ |
| 33 | + |
| 34 | + $global = 1; |
| 35 | + $other_global = 2; |
| 36 | + return 'uses_global worked'; |
| 37 | + |
| 38 | +$$; |
| 39 | +ERROR: Global symbol "$global" requires explicit package name (did you forget to declare "my $global"?) at line 3. |
| 40 | +Global symbol "$other_global" requires explicit package name (did you forget to declare "my $other_global"?) at line 4. |
| 41 | +CONTEXT: compilation of PL/Perl function "uses_global" |
| 42 | +select uses_global(); |
| 43 | +ERROR: function uses_global() does not exist |
| 44 | +LINE 1: select uses_global(); |
| 45 | + ^ |
| 46 | +HINT: No function matches the given name and argument types. You might need to add explicit type casts. |
| 47 | +SET plperl.use_strict = false; |
| 48 | +create or replace function uses_global() returns text language plperl as $$ |
| 49 | + |
| 50 | + $global = 1; |
| 51 | + $other_global=2; |
| 52 | + return 'uses_global worked'; |
| 53 | + |
| 54 | +$$; |
| 55 | +select uses_global(); |
| 56 | + uses_global |
| 57 | +-------------------- |
| 58 | + uses_global worked |
| 59 | +(1 row) |
| 60 | + |
| 61 | +-- make sure we don't choke on readonly values |
| 62 | +do language plperl $$ elog(NOTICE, ${^TAINT}); $$; |
| 63 | +NOTICE: 0 |
| 64 | +CONTEXT: PL/Perl anonymous code block |
| 65 | +-- test recovery after "die" |
| 66 | +create or replace function just_die() returns void language plperl AS $$ |
| 67 | +die "just die"; |
| 68 | +$$; |
| 69 | +select just_die(); |
| 70 | +ERROR: just die at line 2. |
| 71 | +CONTEXT: PL/Perl function "just_die" |
| 72 | +create or replace function die_caller() returns int language plpgsql as $$ |
| 73 | +BEGIN |
| 74 | + BEGIN |
| 75 | + PERFORM just_die(); |
| 76 | + EXCEPTION WHEN OTHERS THEN |
| 77 | + RAISE NOTICE 'caught die'; |
| 78 | + END; |
| 79 | + RETURN 1; |
| 80 | +END; |
| 81 | +$$; |
| 82 | +select die_caller(); |
| 83 | +NOTICE: caught die |
| 84 | + die_caller |
| 85 | +------------ |
| 86 | + 1 |
| 87 | +(1 row) |
| 88 | + |
| 89 | +create or replace function indirect_die_caller() returns int language plperl as $$ |
| 90 | +my $prepared = spi_prepare('SELECT die_caller() AS fx'); |
| 91 | +my $a = spi_exec_prepared($prepared)->{rows}->[0]->{fx}; |
| 92 | +my $b = spi_exec_prepared($prepared)->{rows}->[0]->{fx}; |
| 93 | +return $a + $b; |
| 94 | +$$; |
| 95 | +select indirect_die_caller(); |
| 96 | +NOTICE: caught die |
| 97 | +CONTEXT: SQL statement "SELECT die_caller() AS fx" |
| 98 | +PL/Perl function "indirect_die_caller" |
| 99 | +NOTICE: caught die |
| 100 | +CONTEXT: SQL statement "SELECT die_caller() AS fx" |
| 101 | +PL/Perl function "indirect_die_caller" |
| 102 | + indirect_die_caller |
| 103 | +--------------------- |
| 104 | + 2 |
| 105 | +(1 row) |
| 106 | + |
0 commit comments