Skip to content

Commit bcaefe6

Browse files
author
Depesz Lubaczewski
committed
db-tests framework. Currently tests plperl if it works sanely
1 parent 5cfcf17 commit bcaefe6

8 files changed

+249
-0
lines changed

‎db-tests/00-prepare.sql

+16
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
BEGIN;
2+
3+
-- This is basically CREATE LANGUAGE IF NOT EXISTS - vide http://andreas.scherbaum.la/blog/archives/346-create-language-if-not-exist.html
4+
CREATE OR REPLACE FUNCTION public.create_plpgsql_language () RETURNS setof TEXT AS $$ CREATE LANGUAGE plpgsql; SELECT 'x'::TEXT WHERE 1=0;$$ LANGUAGE 'sql';
5+
SELECT public.create_plpgsql_language () WHERE NOT exists (SELECT * FROM pg_language WHERE lanname='plpgsql');
6+
DROP FUNCTION public.create_plpgsql_language ();
7+
-- This is basically CREATE LANGUAGE IF NOT EXISTS - vide http://andreas.scherbaum.la/blog/archives/346-create-language-if-not-exist.html
8+
9+
CREATE SCHEMA pgtap;
10+
SET search_path TO pgtap, public;
11+
\i /home/pgdba/work-8.4.1/share/postgresql/contrib/pgtap.sql
12+
13+
CREATE OR REPLACE FUNCTION execute(TEXT) RETURNS void as $$BEGIN execute $1; END;$$ language plpgsql;
14+
SELECT execute('ALTER DATABASE ' || quote_ident( current_database() ) || ' SET search_path = pgtap, public');
15+
16+
COMMIT;

‎db-tests/99-cleanup.sql

+8
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
BEGIN;
2+
3+
SELECT execute('ALTER DATABASE ' || quote_ident( current_database() ) || ' RESET search_path');
4+
5+
SET client_min_messages = WARNING;
6+
DROP SCHEMA pgtap cascade;
7+
8+
COMMIT;

‎db-tests/plperl.sh

+23
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
#!/bin/bash
2+
3+
export PATH=/home/pgdba/work-8.4.1/bin:/usr/local/bin:/usr/bin:/bin
4+
# DB Connection details, using PG* environment variables, as described http://www.postgresql.org/docs/current/interactive/libpq-envars.html
5+
PGUSER=depesz
6+
PGHOST=localhost
7+
PGPORT=5840
8+
PGDATABASE=depesz
9+
# DB Connection details, using PG* environment variables, as described http://www.postgresql.org/docs/current/interactive/libpq-envars.html
10+
11+
# Make it stop on error, and print all commands before running
12+
13+
set -e
14+
set -x
15+
16+
# Prepare test environment
17+
psql -qAtX -f 00-prepare.sql
18+
19+
# Run the tests themselves
20+
pg_prove plperl/*.sql
21+
22+
# Clean test environment
23+
psql -qAtX -f 99-cleanup.sql

‎db-tests/plperl/0001-basics.sql

+44
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
\set ECHO
2+
\set QUIET 1
3+
4+
\pset format unaligned
5+
\pset tuples_only true
6+
\pset pager
7+
8+
\set ON_ERROR_ROLLBACK 1
9+
\set ON_ERROR_STOP true
10+
\set QUIET 1
11+
12+
BEGIN;
13+
SELECT plan(18);
14+
15+
SELECT lives_ok( 'CREATE LANGUAGE plperl', 'Language creation should work fine?!' );
16+
17+
SELECT throws_ok( 'CREATE function x() RETURNS TEXT as $$xx++$$ language plperl');
18+
19+
SELECT throws_ok( 'CREATE function x() RETURNS TEXT as $$use Data::Dumper;$$ language plperl');
20+
21+
SELECT lives_ok( 'CREATE function x_text() RETURNS TEXT as $$return "Test String"$$ language plperl', 'Returning TEXT');
22+
SELECT ok( x_text() = 'Test String'::TEXT, 'Simple call to function returning TEXT');
23+
24+
SELECT lives_ok( 'CREATE function x_int4() RETURNS INT4 as $$return 567123$$ language plperl', 'Returning INT4');
25+
SELECT ok( x_int4() = 567123::INT4, 'Simple call to function returning INT4');
26+
27+
SELECT lives_ok( 'CREATE function x_numeric() RETURNS NUMERIC as $$return 123.456$$ language plperl', 'Returning NUMERIC');
28+
SELECT ok( x_numeric() = 123.456::NUMERIC, 'Simple call to function returning NUMERIC');
29+
30+
SELECT lives_ok( 'CREATE function x_timestamptz() RETURNS TIMESTAMPTZ as $$return q{2008-02-28 17:56:23 EDT}$$ language plperl', 'Returning TIMESTAMPTZ');
31+
SELECT ok( x_timestamptz() = '2008-02-29 07:56:23 AEST'::TIMESTAMPTZ, 'Simple call to function returning TIMESTAMPTZ');
32+
33+
SELECT lives_ok( 'CREATE function y_text(TEXT) RETURNS TEXT as $$return scalar reverse shift$$ language plperl', 'Taking and returning TEXT');
34+
SELECT ok( y_text('OmniTI') = 'ITinmO', 'Simple call to function processing TEXT');
35+
36+
SELECT lives_ok( 'CREATE function y_int4(INT4) RETURNS INT4 as $$return $_[0] / 2$$ language plperl', 'Taking and returning INT4');
37+
SELECT throws_ok( 'SELECT y_int4(3) = 1' );
38+
SELECT ok( y_int4(4) = 2, 'Simple call to function processing INT4');
39+
40+
SELECT lives_ok( 'CREATE function y_numeric(NUMERIC) RETURNS NUMERIC as $$return $_[0] / 2$$ language plperl', 'Taking and returning NUMERIC');
41+
SELECT ok( y_numeric(5) = 2.5, 'Simple call to function processing NUMERIC');
42+
43+
SELECT * FROM finish();
44+
ROLLBACK;

‎db-tests/plperl/0010-i18n.sql

+43
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
\set ECHO
2+
\set QUIET 1
3+
4+
\pset format unaligned
5+
\pset tuples_only true
6+
\pset pager
7+
8+
\set ON_ERROR_ROLLBACK 1
9+
\set ON_ERROR_STOP true
10+
\set QUIET 1
11+
12+
SET client_encoding = utf8;
13+
14+
BEGIN;
15+
SELECT plan(19);
16+
17+
SELECT lives_ok( 'CREATE LANGUAGE plperl', 'Language creation should work fine?!' );
18+
19+
SELECT lives_ok( 'CREATE function pl_uc(TEXT) RETURNS TEXT as $$return uc shift$$ language plperl', 'Uppercase conversion');
20+
SELECT lives_ok( 'CREATE function pl_lc(TEXT) RETURNS TEXT as $$return lc shift$$ language plperl', 'Lowercase conversion');
21+
SELECT lives_ok( 'CREATE function pl_re(TEXT, TEXT) RETURNS TEXT as $$return $_[0] =~ $_[1] ? $& : "NOT MATCHED"$$ language plperl', 'Regexp matching');
22+
SELECT lives_ok( E'CREATE function pl_euro() RETURNS TEXT as $$return "\\x{20AC}"$$ language plperl', 'Euro character');
23+
24+
SELECT ok( upper('OmniTI') = 'OMNITI', 'Uppercase sanity check, base string, just a-z letters');
25+
SELECT ok( pl_uc('OmniTI') = upper('OmniTI'), 'Uppercase, base string, just a-z letters');
26+
SELECT ok( lower('OmniTI') = 'omniti', 'Lowercase sanity check, base string, just a-z letters');
27+
SELECT ok( pl_lc('OmniTI') = lower('OmniTI'), 'Lowercase, base string, just a-z letters');
28+
29+
SELECT ok( 'ZAŻÓŁĆ GĘŚLĄ JAŹŃ' = upper('ZażółĆ gĘŚlą jaŹń'), 'Uppercase polish accented letters' );
30+
SELECT ok( pl_uc('ZażółĆ gĘŚlą jaŹń') = upper('ZażółĆ gĘŚlą jaŹń'), 'Uppercase polish accented letters' );
31+
SELECT ok( 'zażółć gęślą jaźń' = lower('ZażółĆ gĘŚlą jaŹń'), 'Lowercase polish accented letters' );
32+
SELECT ok( pl_lc('ZażółĆ gĘŚlą jaŹń') = lower('ZażółĆ gĘŚlą jaŹń'), 'Lowercase polish accented letters' );
33+
34+
SELECT ok( pl_re('OmniTI', 'ni') = 'ni' );
35+
SELECT ok( pl_re('OmniTI', 'n.') = 'ni' );
36+
SELECT ok( pl_re('Zażółć', 'a..') = 'ażó' );
37+
SELECT ok( pl_re('Zażółć', 'Ż..') = 'NOT MATCHED' );
38+
SELECT ok( pl_re('Zażółć', '(?i-xsm:Ż..)') = 'żół' );
39+
40+
SELECT is( pl_euro(), '€' );
41+
42+
SELECT * FROM finish();
43+
ROLLBACK;

‎db-tests/plperl/0020-arrays.sql

+62
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
\set ECHO
2+
\set QUIET 1
3+
4+
\pset format unaligned
5+
\pset tuples_only true
6+
\pset pager
7+
8+
\set ON_ERROR_ROLLBACK 1
9+
\set ON_ERROR_STOP true
10+
\set QUIET 1
11+
12+
SET client_encoding = utf8;
13+
14+
BEGIN;
15+
SELECT plan(8);
16+
17+
SELECT lives_ok( 'CREATE LANGUAGE plperl', 'Language creation should work fine?!' );
18+
19+
SELECT lives_ok( E'CREATE function test1(int4[]) RETURNS INT4 as $$my $i = shift; die "x1 [$i]\\n" unless $i =~ s/^\{(-?\\d+(?:,-?\\d+)*)\}$/$1/; my @a = split /,/, $i; my $q = 0; $q+=$_ for @a; return $q$$ language plperl');
20+
21+
SELECT is( test1(ARRAY[5,10,15]), 30 );
22+
SELECT is( test1(ARRAY[-517, 20, 84, -600, 1030]), 17 );
23+
24+
SELECT lives_ok(
25+
$FUNC$
26+
CREATE function test2(TEXT[]) RETURNS TEXT as $$
27+
my $string = shift || '';
28+
die "x2 [$string]\n" unless $string =~ s/\A\{(.*)\}\z/$1/;
29+
my @elements = ();
30+
my $current = '';
31+
my $in_quotes = undef;
32+
my @chars = split //, $string;
33+
for (my $i = 0 ; $i < scalar @chars; $i++) {
34+
my $char = $chars[$i];
35+
if ($char eq ',') {
36+
if ($in_quotes) {
37+
$current .= $char;
38+
} else {
39+
push @elements, $current;
40+
$current = '';
41+
}
42+
} elsif ( $char eq '"') {
43+
$in_quotes = !$in_quotes;
44+
} elsif ( ($char eq '\\') && ( $in_quotes ) ) {
45+
$i++;
46+
$current .= $chars[$i];
47+
} else {
48+
$current .= $char;
49+
}
50+
}
51+
push @elements, $current;
52+
return "[" . join("],[", sort @elements) . "]";
53+
$$ language plperl
54+
$FUNC$
55+
);
56+
57+
SELECT is( test2( ARRAY[ 'a', 'z', 'b', 'p', 'c' ] ), '[a],[b],[c],[p],[z]' );
58+
SELECT is( test2( ARRAY[ E'x\\r', 'a'] ), E'[a],[x\\r]' );
59+
SELECT is( test2( ARRAY[ 'a''qq', 'b'] ), '[a''qq],[b]' );
60+
61+
SELECT * FROM finish();
62+
ROLLBACK;

‎db-tests/plperl/0030-recordset.sql

+28
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
\set ECHO
2+
\set QUIET 1
3+
4+
\pset format unaligned
5+
\pset tuples_only true
6+
\pset pager
7+
8+
\set ON_ERROR_ROLLBACK 1
9+
\set ON_ERROR_STOP true
10+
\set QUIET 1
11+
12+
SET client_encoding = utf8;
13+
14+
BEGIN;
15+
SELECT plan(3);
16+
17+
SELECT lives_ok( 'CREATE LANGUAGE plperl', 'Language creation should work fine?!' );
18+
19+
CREATE type t1_srf as ( x TEXT, i INT4 );
20+
SELECT lives_ok( E'CREATE function test1() RETURNS setof t1_srf as $$ return [ { "x" => "r1", "i" => 100 }, {"x" => "r2", "i" => 200} ]; $$ language plperl');
21+
22+
SELECT results_eq(
23+
'SELECT * FROM test1()',
24+
$$VALUES ( 'r1', 100 ), ('r2', 200)$$
25+
);
26+
27+
SELECT * FROM finish();
28+
ROLLBACK;

‎db-tests/plperl/0040-exceptions.sql

+25
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
\set ECHO
2+
\set QUIET 1
3+
4+
\pset format unaligned
5+
\pset tuples_only true
6+
\pset pager
7+
8+
\set ON_ERROR_ROLLBACK 1
9+
\set ON_ERROR_STOP true
10+
\set QUIET 1
11+
12+
SET client_encoding = utf8;
13+
14+
BEGIN;
15+
SELECT plan(4);
16+
17+
SELECT lives_ok( 'CREATE LANGUAGE plperl', 'Language creation should work fine?!' );
18+
19+
SELECT lives_ok( E'CREATE function test1(INT4) RETURNS INT4 as $$ die "TEST\n" if $_[0] == 0; return 1; $$ language plperl');
20+
21+
SELECT lives_ok( 'SELECT test1(1)' );
22+
SELECT throws_ok( 'SELECT test1(0)', 'XX000', 'error from Perl function "test1": TEST', 'Basic die() handling' );
23+
24+
SELECT * FROM finish();
25+
ROLLBACK;

0 commit comments

Comments
 (0)