diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 12:19:15 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 12:19:15 +0000 |
commit | 6eb9c5a5657d1fe77b55cc261450f3538d35a94d (patch) | |
tree | 657d8194422a5daccecfd42d654b8a245ef7b4c8 /contrib/bool_plperl | |
parent | Initial commit. (diff) | |
download | postgresql-13-6eb9c5a5657d1fe77b55cc261450f3538d35a94d.tar.xz postgresql-13-6eb9c5a5657d1fe77b55cc261450f3538d35a94d.zip |
Adding upstream version 13.4.upstream/13.4upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'contrib/bool_plperl')
-rw-r--r-- | contrib/bool_plperl/.gitignore | 4 | ||||
-rw-r--r-- | contrib/bool_plperl/Makefile | 39 | ||||
-rw-r--r-- | contrib/bool_plperl/bool_plperl--1.0.sql | 19 | ||||
-rw-r--r-- | contrib/bool_plperl/bool_plperl.c | 30 | ||||
-rw-r--r-- | contrib/bool_plperl/bool_plperl.control | 7 | ||||
-rw-r--r-- | contrib/bool_plperl/bool_plperlu--1.0.sql | 19 | ||||
-rw-r--r-- | contrib/bool_plperl/bool_plperlu.control | 6 | ||||
-rw-r--r-- | contrib/bool_plperl/expected/bool_plperl.out | 112 | ||||
-rw-r--r-- | contrib/bool_plperl/expected/bool_plperlu.out | 112 | ||||
-rw-r--r-- | contrib/bool_plperl/sql/bool_plperl.sql | 70 | ||||
-rw-r--r-- | contrib/bool_plperl/sql/bool_plperlu.sql | 70 |
11 files changed, 488 insertions, 0 deletions
diff --git a/contrib/bool_plperl/.gitignore b/contrib/bool_plperl/.gitignore new file mode 100644 index 0000000..5dcb3ff --- /dev/null +++ b/contrib/bool_plperl/.gitignore @@ -0,0 +1,4 @@ +# Generated subdirectories +/log/ +/results/ +/tmp_check/ diff --git a/contrib/bool_plperl/Makefile b/contrib/bool_plperl/Makefile new file mode 100644 index 0000000..efe1de9 --- /dev/null +++ b/contrib/bool_plperl/Makefile @@ -0,0 +1,39 @@ +# contrib/bool_plperl/Makefile + +MODULE_big = bool_plperl +OBJS = \ + $(WIN32RES) \ + bool_plperl.o +PGFILEDESC = "bool_plperl - bool transform for plperl" + +PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl + +EXTENSION = bool_plperlu bool_plperl +DATA = bool_plperlu--1.0.sql bool_plperl--1.0.sql + +REGRESS = bool_plperl bool_plperlu + +ifdef USE_PGXS +PG_CONFIG = pg_config +PGXS := $(shell $(PG_CONFIG) --pgxs) +include $(PGXS) +else +subdir = contrib/bool_plperl +top_builddir = ../.. +include $(top_builddir)/src/Makefile.global +include $(top_srcdir)/contrib/contrib-global.mk +endif + +# We must link libperl explicitly +ifeq ($(PORTNAME), win32) +# these settings are the same as for plperl +override CPPFLAGS += -DPLPERL_HAVE_UID_GID -Wno-comment +# ... see silliness in plperl Makefile ... +SHLIB_LINK_INTERNAL += $(sort $(wildcard ../../src/pl/plperl/libperl*.a)) +else +rpathdir = $(perl_archlibexp)/CORE +SHLIB_LINK += $(perl_embed_ldflags) +endif + +# As with plperl we need to include the perl_includespec directory last. +override CPPFLAGS := $(CPPFLAGS) $(perl_embed_ccflags) $(perl_includespec) diff --git a/contrib/bool_plperl/bool_plperl--1.0.sql b/contrib/bool_plperl/bool_plperl--1.0.sql new file mode 100644 index 0000000..00dc3b8 --- /dev/null +++ b/contrib/bool_plperl/bool_plperl--1.0.sql @@ -0,0 +1,19 @@ +/* contrib/bool_plperl/bool_plperl--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION bool_plperl" to load this file. \quit + +CREATE FUNCTION bool_to_plperl(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE FUNCTION plperl_to_bool(val internal) RETURNS bool +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE TRANSFORM FOR bool LANGUAGE plperl ( + FROM SQL WITH FUNCTION bool_to_plperl(internal), + TO SQL WITH FUNCTION plperl_to_bool(internal) +); + +COMMENT ON TRANSFORM FOR bool LANGUAGE plperl IS 'transform between bool and Perl'; diff --git a/contrib/bool_plperl/bool_plperl.c b/contrib/bool_plperl/bool_plperl.c new file mode 100644 index 0000000..0fa1eee --- /dev/null +++ b/contrib/bool_plperl/bool_plperl.c @@ -0,0 +1,30 @@ +#include "postgres.h" + +#include "fmgr.h" +#include "plperl.h" + + +PG_MODULE_MAGIC; + +PG_FUNCTION_INFO_V1(bool_to_plperl); + +Datum +bool_to_plperl(PG_FUNCTION_ARGS) +{ + dTHX; + bool in = PG_GETARG_BOOL(0); + + return PointerGetDatum(in ? &PL_sv_yes : &PL_sv_no); +} + + +PG_FUNCTION_INFO_V1(plperl_to_bool); + +Datum +plperl_to_bool(PG_FUNCTION_ARGS) +{ + dTHX; + SV *in = (SV *) PG_GETARG_POINTER(0); + + PG_RETURN_BOOL(SvTRUE(in)); +} diff --git a/contrib/bool_plperl/bool_plperl.control b/contrib/bool_plperl/bool_plperl.control new file mode 100644 index 0000000..af3e6b1 --- /dev/null +++ b/contrib/bool_plperl/bool_plperl.control @@ -0,0 +1,7 @@ +# bool_plperl extension +comment = 'transform between bool and plperl' +default_version = '1.0' +module_pathname = '$libdir/bool_plperl' +relocatable = true +trusted = true +requires = 'plperl' diff --git a/contrib/bool_plperl/bool_plperlu--1.0.sql b/contrib/bool_plperl/bool_plperlu--1.0.sql new file mode 100644 index 0000000..52c55b6 --- /dev/null +++ b/contrib/bool_plperl/bool_plperlu--1.0.sql @@ -0,0 +1,19 @@ +/* contrib/bool_plperl/bool_plperlu--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION bool_plperlu" to load this file. \quit + +CREATE FUNCTION bool_to_plperlu(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'bool_to_plperl'; + +CREATE FUNCTION plperlu_to_bool(val internal) RETURNS bool +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'plperl_to_bool'; + +CREATE TRANSFORM FOR bool LANGUAGE plperlu ( + FROM SQL WITH FUNCTION bool_to_plperlu(internal), + TO SQL WITH FUNCTION plperlu_to_bool(internal) +); + +COMMENT ON TRANSFORM FOR bool LANGUAGE plperlu IS 'transform between bool and Perl'; diff --git a/contrib/bool_plperl/bool_plperlu.control b/contrib/bool_plperl/bool_plperlu.control new file mode 100644 index 0000000..d03a584 --- /dev/null +++ b/contrib/bool_plperl/bool_plperlu.control @@ -0,0 +1,6 @@ +# bool_plperlu extension +comment = 'transform between bool and plperlu' +default_version = '1.0' +module_pathname = '$libdir/bool_plperl' +relocatable = true +requires = 'plperlu' diff --git a/contrib/bool_plperl/expected/bool_plperl.out b/contrib/bool_plperl/expected/bool_plperl.out new file mode 100644 index 0000000..187df8d --- /dev/null +++ b/contrib/bool_plperl/expected/bool_plperl.out @@ -0,0 +1,112 @@ +CREATE EXTENSION bool_plperl CASCADE; +NOTICE: installing required extension "plperl" +--- test transforming from perl +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; +SELECT perl2int(1); + perl2int +---------- + t +(1 row) + +SELECT perl2int(0); + perl2int +---------- + f +(1 row) + +SELECT perl2text('foo'); + perl2text +----------- + t +(1 row) + +SELECT perl2text(''); + perl2text +----------- + f +(1 row) + +SELECT perl2undef() IS NULL AS p; + p +--- + t +(1 row) + +--- test transforming to perl +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool, for type boolean -- duplicate to test ruleutils +AS $$ +my ($x, $y, $z) = @_; + +die("NULL mistransformed") if (defined($z)); +die("TRUE mistransformed to UNDEF") if (!defined($x)); +die("FALSE mistransformed to UNDEF") if (!defined($y)); +die("TRUE mistransformed") if (!$x); +die("FALSE mistransformed") if ($y); +$$; +SELECT bool2perl (true, false, NULL); + bool2perl +----------- + +(1 row) + +--- test ruleutils +\sf bool2perl +CREATE OR REPLACE FUNCTION public.bool2perl(boolean, boolean, boolean) + RETURNS void + TRANSFORM FOR TYPE boolean, FOR TYPE boolean + LANGUAGE plperl +AS $function$ +my ($x, $y, $z) = @_; + +die("NULL mistransformed") if (defined($z)); +die("TRUE mistransformed to UNDEF") if (!defined($x)); +die("FALSE mistransformed to UNDEF") if (!defined($y)); +die("TRUE mistransformed") if (!$x); +die("FALSE mistransformed") if ($y); +$function$ +--- test selecting bool through SPI +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; + +die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t})); +die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f})); +die("NULL mistransformed in SPI") if (defined ($rv->{n})); +die("TRUE mistransformed in SPI") if (!$rv->{t}); +die("FALSE mistransformed in SPI") if ($rv->{f}); +$$; +SELECT spi_test(); + spi_test +---------- + +(1 row) + +DROP EXTENSION plperl CASCADE; +NOTICE: drop cascades to 6 other objects +DETAIL: drop cascades to function spi_test() +drop cascades to extension bool_plperl +drop cascades to function perl2int(integer) +drop cascades to function perl2text(text) +drop cascades to function perl2undef() +drop cascades to function bool2perl(boolean,boolean,boolean) diff --git a/contrib/bool_plperl/expected/bool_plperlu.out b/contrib/bool_plperl/expected/bool_plperlu.out new file mode 100644 index 0000000..8337d33 --- /dev/null +++ b/contrib/bool_plperl/expected/bool_plperlu.out @@ -0,0 +1,112 @@ +CREATE EXTENSION bool_plperlu CASCADE; +NOTICE: installing required extension "plperlu" +--- test transforming from perl +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; +SELECT perl2int(1); + perl2int +---------- + t +(1 row) + +SELECT perl2int(0); + perl2int +---------- + f +(1 row) + +SELECT perl2text('foo'); + perl2text +----------- + t +(1 row) + +SELECT perl2text(''); + perl2text +----------- + f +(1 row) + +SELECT perl2undef() IS NULL AS p; + p +--- + t +(1 row) + +--- test transforming to perl +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool, for type boolean -- duplicate to test ruleutils +AS $$ +my ($x, $y, $z) = @_; + +die("NULL mistransformed") if (defined($z)); +die("TRUE mistransformed to UNDEF") if (!defined($x)); +die("FALSE mistransformed to UNDEF") if (!defined($y)); +die("TRUE mistransformed") if (!$x); +die("FALSE mistransformed") if ($y); +$$; +SELECT bool2perl (true, false, NULL); + bool2perl +----------- + +(1 row) + +--- test ruleutils +\sf bool2perl +CREATE OR REPLACE FUNCTION public.bool2perl(boolean, boolean, boolean) + RETURNS void + TRANSFORM FOR TYPE boolean, FOR TYPE boolean + LANGUAGE plperlu +AS $function$ +my ($x, $y, $z) = @_; + +die("NULL mistransformed") if (defined($z)); +die("TRUE mistransformed to UNDEF") if (!defined($x)); +die("FALSE mistransformed to UNDEF") if (!defined($y)); +die("TRUE mistransformed") if (!$x); +die("FALSE mistransformed") if ($y); +$function$ +--- test selecting bool through SPI +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; + +die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t})); +die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f})); +die("NULL mistransformed in SPI") if (defined ($rv->{n})); +die("TRUE mistransformed in SPI") if (!$rv->{t}); +die("FALSE mistransformed in SPI") if ($rv->{f}); +$$; +SELECT spi_test(); + spi_test +---------- + +(1 row) + +DROP EXTENSION plperlu CASCADE; +NOTICE: drop cascades to 6 other objects +DETAIL: drop cascades to function spi_test() +drop cascades to extension bool_plperlu +drop cascades to function perl2int(integer) +drop cascades to function perl2text(text) +drop cascades to function perl2undef() +drop cascades to function bool2perl(boolean,boolean,boolean) diff --git a/contrib/bool_plperl/sql/bool_plperl.sql b/contrib/bool_plperl/sql/bool_plperl.sql new file mode 100644 index 0000000..b7f5708 --- /dev/null +++ b/contrib/bool_plperl/sql/bool_plperl.sql @@ -0,0 +1,70 @@ +CREATE EXTENSION bool_plperl CASCADE; + +--- test transforming from perl + +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; + +SELECT perl2int(1); +SELECT perl2int(0); +SELECT perl2text('foo'); +SELECT perl2text(''); +SELECT perl2undef() IS NULL AS p; + +--- test transforming to perl + +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool, for type boolean -- duplicate to test ruleutils +AS $$ +my ($x, $y, $z) = @_; + +die("NULL mistransformed") if (defined($z)); +die("TRUE mistransformed to UNDEF") if (!defined($x)); +die("FALSE mistransformed to UNDEF") if (!defined($y)); +die("TRUE mistransformed") if (!$x); +die("FALSE mistransformed") if ($y); +$$; + +SELECT bool2perl (true, false, NULL); + +--- test ruleutils + +\sf bool2perl + +--- test selecting bool through SPI + +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; + +die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t})); +die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f})); +die("NULL mistransformed in SPI") if (defined ($rv->{n})); +die("TRUE mistransformed in SPI") if (!$rv->{t}); +die("FALSE mistransformed in SPI") if ($rv->{f}); +$$; + +SELECT spi_test(); + +DROP EXTENSION plperl CASCADE; diff --git a/contrib/bool_plperl/sql/bool_plperlu.sql b/contrib/bool_plperl/sql/bool_plperlu.sql new file mode 100644 index 0000000..1480a04 --- /dev/null +++ b/contrib/bool_plperl/sql/bool_plperlu.sql @@ -0,0 +1,70 @@ +CREATE EXTENSION bool_plperlu CASCADE; + +--- test transforming from perl + +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; + +SELECT perl2int(1); +SELECT perl2int(0); +SELECT perl2text('foo'); +SELECT perl2text(''); +SELECT perl2undef() IS NULL AS p; + +--- test transforming to perl + +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool, for type boolean -- duplicate to test ruleutils +AS $$ +my ($x, $y, $z) = @_; + +die("NULL mistransformed") if (defined($z)); +die("TRUE mistransformed to UNDEF") if (!defined($x)); +die("FALSE mistransformed to UNDEF") if (!defined($y)); +die("TRUE mistransformed") if (!$x); +die("FALSE mistransformed") if ($y); +$$; + +SELECT bool2perl (true, false, NULL); + +--- test ruleutils + +\sf bool2perl + +--- test selecting bool through SPI + +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; + +die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t})); +die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f})); +die("NULL mistransformed in SPI") if (defined ($rv->{n})); +die("TRUE mistransformed in SPI") if (!$rv->{t}); +die("FALSE mistransformed in SPI") if ($rv->{f}); +$$; + +SELECT spi_test(); + +DROP EXTENSION plperlu CASCADE; |