diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile index 188d7d2..8ab90a6 100644 --- a/src/pl/plperl/GNUmakefile +++ b/src/pl/plperl/GNUmakefile @@ -44,7 +44,9 @@ PERLCHUNKS = plc_perlboot.pl plc_trusted.pl SHLIB_LINK = $(perl_embed_ldflags) REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=plperl --load-extension=plperlu -REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array +REGRESS_LC0 = $(subst .sql,,$(shell cd sql; ls plperl_lc_$(shell echo $(ENCODING) | tr "A-Z-" "a-z_").sql 2>/dev/null)) +REGRESS_LC = $(if $(REGRESS_LC0),$(REGRESS_LC0),plperl_lc) +REGRESS = plperl $(REGRESS_LC) plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array # if Perl can support two interpreters in one backend, # test plperl-and-plperlu cases ifneq ($(PERL),) diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index df54937..906dc15 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -650,16 +650,6 @@ CONTEXT: PL/Perl anonymous code block DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl; ERROR: Useless use of sort in scalar context at line 1. CONTEXT: PL/Perl anonymous code block --- --- Make sure strings are validated --- Should fail for all encodings, as nul bytes are never permitted. --- -CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$ - return "abcd\0efg"; -$$ LANGUAGE plperl; -SELECT perl_zerob(); -ERROR: invalid byte sequence for encoding "UTF8": 0x00 -CONTEXT: PL/Perl function "perl_zerob" -- make sure functions marked as VOID without an explicit return work CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$ $_SHARED{myquote} = sub { diff --git a/src/pl/plperl/expected/plperl_lc.out b/src/pl/plperl/expected/plperl_lc.out new file mode 100644 index 0000000..4f8c08f --- /dev/null +++ b/src/pl/plperl/expected/plperl_lc.out @@ -0,0 +1,10 @@ +-- +-- Make sure strings are validated +-- Should fail for all encodings, as nul bytes are never permitted. +-- +CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$ + return "abcd\0efg"; +$$ LANGUAGE plperl; +SELECT perl_zerob(); +ERROR: invalid byte sequence for encoding "UTF8": 0x00 +CONTEXT: PL/Perl function "perl_zerob" diff --git a/src/pl/plperl/expected/plperl_lc_sql_ascii.out b/src/pl/plperl/expected/plperl_lc_sql_ascii.out new file mode 100644 index 0000000..022c3e2 --- /dev/null +++ b/src/pl/plperl/expected/plperl_lc_sql_ascii.out @@ -0,0 +1,10 @@ +-- +-- Make sure strings are validated +-- Should fail for all encodings, as nul bytes are never permitted. +-- +CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$ + return "abcd\0efg"; +$$ LANGUAGE plperl; +SELECT perl_zerob(); +ERROR: invalid byte sequence for encoding "SQL_ASCII": 0x00 +CONTEXT: PL/Perl function "perl_zerob" diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql index 84af1fd..a5e3840 100644 --- a/src/pl/plperl/sql/plperl.sql +++ b/src/pl/plperl/sql/plperl.sql @@ -423,15 +423,6 @@ DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl; -- yields "ERROR: Useless use of sort in scalar context." DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl; --- --- Make sure strings are validated --- Should fail for all encodings, as nul bytes are never permitted. --- -CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$ - return "abcd\0efg"; -$$ LANGUAGE plperl; -SELECT perl_zerob(); - -- make sure functions marked as VOID without an explicit return work CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$ $_SHARED{myquote} = sub { diff --git a/src/pl/plperl/sql/plperl_lc.sql b/src/pl/plperl/sql/plperl_lc.sql new file mode 100644 index 0000000..a4a06e7 --- /dev/null +++ b/src/pl/plperl/sql/plperl_lc.sql @@ -0,0 +1,8 @@ +-- +-- Make sure strings are validated +-- Should fail for all encodings, as nul bytes are never permitted. +-- +CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$ + return "abcd\0efg"; +$$ LANGUAGE plperl; +SELECT perl_zerob(); diff --git a/src/pl/plperl/sql/plperl_lc_sql_ascii.sql b/src/pl/plperl/sql/plperl_lc_sql_ascii.sql new file mode 120000 index 0000000..9da97db --- /dev/null +++ b/src/pl/plperl/sql/plperl_lc_sql_ascii.sql @@ -0,0 +1 @@ +plperl_lc.sql \ No newline at end of file