Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
Skip to content

Commit 103382a

Browse files
committed
PL/Perl: Add alternative expected file for Perl 5.22
1 parent f0a264a commit 103382a

File tree

1 file changed

+106
-0
lines changed

1 file changed

+106
-0
lines changed
+106
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
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

Comments
 (0)