src/pl/plperl/expected/plperl_util.out

   1 -- test plperl utility functions (defined in Util.xs)
   2 -- test quote_literal
   3 create or replace function perl_quote_literal() returns setof text language plperl as $$
   4         return_next "undef: ".quote_literal(undef);
   5         return_next sprintf"$_: ".quote_literal($_)
   6                 for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
   7         return undef;
   8 $$;
   9 select perl_quote_literal();
  10  perl_quote_literal
  11 --------------------
  12  undef:
  13  foo: 'foo'
  14  a'b: 'a''b'
  15  a"b: 'a"b'
  16  c''d: 'c''''d'
  17  e\f: E'e\\f'
  18  : ''
  19 (7 rows)
  20
  21 -- test quote_nullable
  22 create or replace function perl_quote_nullable() returns setof text language plperl as $$
  23         return_next "undef: ".quote_nullable(undef);
  24         return_next sprintf"$_: ".quote_nullable($_)
  25                 for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
  26         return undef;
  27 $$;
  28 select perl_quote_nullable();
  29  perl_quote_nullable
  30 ---------------------
  31  undef: NULL
  32  foo: 'foo'
  33  a'b: 'a''b'
  34  a"b: 'a"b'
  35  c''d: 'c''''d'
  36  e\f: E'e\\f'
  37  : ''
  38 (7 rows)
  39
  40 -- test quote_ident
  41 create or replace function perl_quote_ident() returns setof text language plperl as $$
  42         return_next "undef: ".quote_ident(undef); # generates undef warning if warnings enabled
  43         return_next "$_: ".quote_ident($_)
  44                 for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{g.h}, q{};
  45         return undef;
  46 $$;
  47 select perl_quote_ident();
  48  perl_quote_ident
  49 ------------------
  50  undef: ""
  51  foo: foo
  52  a'b: "a'b"
  53  a"b: "a""b"
  54  c''d: "c''d"
  55  e\f: "e\f"
  56  g.h: "g.h"
  57  : ""
  58 (8 rows)
  59
  60 -- test decode_bytea
  61 create or replace function perl_decode_bytea() returns setof text language plperl as $$
  62         return_next "undef: ".decode_bytea(undef); # generates undef warning if warnings enabled
  63         return_next "$_: ".decode_bytea($_)
  64                 for q{foo}, q{a\047b}, q{};
  65         return undef;
  66 $$;
  67 select perl_decode_bytea();
  68  perl_decode_bytea
  69 -------------------
  70  undef:
  71  foo: foo
  72  a\047b: a'b
  73  :
  74 (4 rows)
  75
  76 -- test encode_bytea
  77 create or replace function perl_encode_bytea() returns setof text language plperl as $$
  78         return_next encode_bytea(undef); # generates undef warning if warnings enabled
  79         return_next encode_bytea($_)
  80                 for q{@}, qq{@\x01@}, qq{@\x00@}, q{};
  81         return undef;
  82 $$;
  83 select perl_encode_bytea();
  84  perl_encode_bytea
  85 -------------------
  86  \x
  87  \x40
  88  \x400140
  89  \x400040
  90  \x
  91 (5 rows)
  92
  93 -- test encode_array_literal
  94 create or replace function perl_encode_array_literal() returns setof text language plperl as $$
  95         return_next encode_array_literal(undef);
  96         return_next encode_array_literal(0);
  97         return_next encode_array_literal(42);
  98         return_next encode_array_literal($_)
  99                 for [], [0], [1..5], [[]], [[1,2,[3]],4];
 100         return_next encode_array_literal($_,'|')
 101                 for [], [0], [1..5], [[]], [[1,2,[3]],4];
 102         return undef;
 103 $$;
 104 select perl_encode_array_literal();
 105  perl_encode_array_literal
 106 ---------------------------
 107
 108  0
 109  42
 110  {}
 111  {"0"}
 112  {"1", "2", "3", "4", "5"}
 113  {{}}
 114  {{"1", "2", {"3"}}, "4"}
 115  {}
 116  {"0"}
 117  {"1"|"2"|"3"|"4"|"5"}
 118  {{}}
 119  {{"1"|"2"|{"3"}}|"4"}
 120 (13 rows)
 121
 122 -- test encode_array_constructor
 123 create or replace function perl_encode_array_constructor() returns setof text language plperl as $$
 124         return_next encode_array_constructor(undef);
 125         return_next encode_array_constructor(0);
 126         return_next encode_array_constructor(42);
 127         return_next encode_array_constructor($_)
 128                 for [], [0], [1..5], [[]], [[1,2,[3]],4];
 129         return undef;
 130 $$;
 131 select perl_encode_array_constructor();
 132       perl_encode_array_constructor
 133 -----------------------------------------
 134  NULL
 135  '0'
 136  '42'
 137  ARRAY[]
 138  ARRAY['0']
 139  ARRAY['1', '2', '3', '4', '5']
 140  ARRAY[ARRAY[]]
 141  ARRAY[ARRAY['1', '2', ARRAY['3']], '4']
 142 (8 rows)
 143
 144 -- test looks_like_number
 145 create or replace function perl_looks_like_number() returns setof text language plperl as $$
 146         return_next "undef is undef" if not defined looks_like_number(undef);
 147         return_next quote_nullable($_).": ". (looks_like_number($_) ? "number" : "not number")
 148                 for 'foo', 0, 1, 1.3, '+3.e-4',
 149                         '42 x', # trailing garbage
 150                         '99  ', # trailing space
 151                         '  99', # leading space
 152                         '    ', # only space
 153                         '';     # empty string
 154         return undef;
 155 $$;
 156 select perl_looks_like_number();
 157  perl_looks_like_number
 158 ------------------------
 159  undef is undef
 160  'foo': not number
 161  '0': number
 162  '1': number
 163  '1.3': number
 164  '+3.e-4': number
 165  '42 x': not number
 166  '99  ': number
 167  '  99': number
 168  '    ': not number
 169  '': not number
 170 (11 rows)
 171
 172 -- test encode_typed_literal
 173 create type perl_foo as (a integer, b text[]);
 174 create type perl_bar as (c perl_foo[]);
 175 create domain perl_foo_pos as perl_foo check((value).a > 0);
 176 create or replace function perl_encode_typed_literal() returns setof text language plperl as $$
 177         return_next encode_typed_literal(undef, 'text');
 178         return_next encode_typed_literal([[1,2,3],[3,2,1],[1,3,2]], 'integer[]');
 179         return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo');
 180         return_next encode_typed_literal({c => [{a => 9, b => ['PostgreSQL']}, {b => ['Postgres'], a => 1}]}, 'perl_bar');
 181         return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo_pos');
 182 $$;
 183 select perl_encode_typed_literal();
 184            perl_encode_typed_literal
 185 -----------------------------------------------
 186
 187  {{1,2,3},{3,2,1},{1,3,2}}
 188  (1,"{PL,/,Perl}")
 189  ("{""(9,{PostgreSQL})"",""(1,{Postgres})""}")
 190  (1,"{PL,/,Perl}")
 191 (5 rows)
 192
 193 create or replace function perl_encode_typed_literal() returns setof text language plperl as $$
 194         return_next encode_typed_literal({a => 0, b => ['PL','/','Perl']}, 'perl_foo_pos');
 195 $$;
 196 select perl_encode_typed_literal();  -- fail
 197 ERROR:  value for domain perl_foo_pos violates check constraint "perl_foo_pos_check"
 198 CONTEXT:  PL/Perl function "perl_encode_typed_literal"