/
githubmirror
/
postgres
Обзор
Документация
Войти
/
githubmirror
/
postgres
Код
Запросы
0
Пакеты
0
Релизы
0
Аналитика
Безопасность
master
src/pl/plperl/sql/plperl_env.sql
61 строка
1 KB
Tom Lane
Fix cross-version upgrade tests.
11 ноя 2024, 21:57
11 ноя 2024, 21:57
c4252c9
Код
Авторство
О чём код?
-- -- Test the environment setting -- -- directory path and dlsuffix are passed to us in environment variables \getenv libdir PG_LIBDIR \getenv dlsuffix PG_DLSUFFIX \set regresslib :libdir '/regress' :dlsuffix CREATE FUNCTION get_environ() RETURNS text[] AS :'regresslib', 'get_environ' LANGUAGE C STRICT; -- fetch the process environment CREATE FUNCTION process_env () RETURNS text[] LANGUAGE plpgsql AS $$ declare res text[]; tmp text[]; f record; begin for f in select unnest(get_environ()) as t loop tmp := regexp_split_to_array(f.t, '='); if array_length(tmp, 1) = 2 then res := res || tmp; end if; end loop; return res; end $$; -- plperl should not be able to affect the process environment DO $$ $ENV{TEST_PLPERL_ENV_FOO} = "shouldfail"; untie %ENV; $ENV{TEST_PLPERL_ENV_FOO} = "testval"; my $penv = spi_exec_query("select unnest(process_env()) as pe"); my %received; for (my $f = 0; $f < $penv->{processed}; $f += 2) { my $k = $penv->{rows}[$f]->{pe}; my $v = $penv->{rows}[$f+1]->{pe}; $received{$k} = $v; } unless (exists $received{TEST_PLPERL_ENV_FOO}) { elog(NOTICE, "environ unaffected") } $$ LANGUAGE plperl; -- clean up to simplify cross-version upgrade testing DROP FUNCTION get_environ();