branch: elpa/pg
commit cd03d96a3d5d031e1c92f70f938d41b2d51c0282
Author: Eric Marsden <eric.mars...@risk-engineering.org>
Commit: Eric Marsden <eric.mars...@risk-engineering.org>
Add workarounds for PostgreSQL variant CedarDB.
Add additional tests for sequence functionality.
Improve the test for floating point equality.
Add tests for serialization of arrays using the extended query protocol.
---
test/test-pg.el | 350 ++++++++++++++++++++++++++++++++++++++++----------------
1 file changed, 253 insertions(+), 97 deletions(-)
diff --git a/test/test-pg.el b/test/test-pg.el
index fc026a4faed..014ea41e3b3 100755
--- a/test/test-pg.el
+++ b/test/test-pg.el
@@ -23,6 +23,17 @@
;; (setq process-adaptive-read-buffering nil)
+;;
https://www.reidatcheson.com/floating%20point/comparison/2019/03/20/floating-point-comparison.html
+;;
+;; We were using (defun approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs
y))) 1e-5))
+;; which exposed us to division by zero.
+(defun pgtest-approx= (x y)
+ (let ((smallest (min x y)))
+ (if (= (abs smallest) 0.0)
+ (< (abs (- x y)) 1e-5)
+ (< (/ (abs (- x y)) (max 1e-8 smallest)) 1e-5))))
+
+
;; Good practice for PostgreSQL is to replace use of the SERIAL type by
"GENERATED ALWAYS AS
;; IDENTITY". However, several of the PostgreSQL variants that we want to test
don't implement this
;; syntax, so we choose the syntax for this when we establish a connection.
@@ -233,7 +244,7 @@
(message "Backend major-version is %s" (pgcon-server-version-major con))
(message "Detected backend variant: %s" (pgcon-server-variant con))
(unless (member (pgcon-server-variant con)
- '(cockroachdb cratedb yugabyte ydb xata greptimedb
risingwave clickhouse octodb vertica arcadedb))
+ '(cockroachdb cratedb yugabyte ydb xata greptimedb
risingwave clickhouse octodb vertica arcadedb cedardb))
(when (> (pgcon-server-version-major con) 11)
(let* ((res (pg-exec con "SELECT current_setting('ssl_library')"))
(row (pg-result res :tuple 0)))
@@ -257,9 +268,10 @@
(pgtest-add #'pg-test-edge-cases)
(pgtest-add #'pg-test-procedures
:skip-variants '(cratedb spanner risingwave materialize ydb
xata questdb thenile vertica))
- ;; RisingWave is not able to parse a TZ value of "UTC-01:00" (POSIX
format).
+ ;; RisingWave is not able to parse a TZ value of "UTC-01:00" (POSIX
format). QuestDB does not
+ ;; support the timestamptz type. CedarDB des not support the timetz data
type.
(pgtest-add #'pg-test-date
- :skip-variants '(cratedb risingwave materialize ydb)
+ :skip-variants '(cratedb risingwave materialize ydb questdb
cedardb)
:need-emacs "29.1")
;; QuestDB does not support the timestamptz column type.
(pgtest-add #'pg-run-tz-tests
@@ -268,7 +280,7 @@
(pgtest-add #'pg-test-numeric
:skip-variants '(vertica))
(pgtest-add #'pg-test-numeric-range
- :skip-variants '(xata cratedb cockroachdb ydb risingwave
questdb clickhouse greptimedb spanner octodb vertica))
+ :skip-variants '(xata cratedb cockroachdb ydb risingwave
questdb clickhouse greptimedb spanner octodb vertica cedardb))
(pgtest-add #'pg-test-prepared
:skip-variants '(ydb cratedb)
:need-emacs "28")
@@ -295,7 +307,7 @@
(pgtest-add #'pg-test-result
:skip-variants '(risingwave ydb spanner clickhouse vertica))
(pgtest-add #'pg-test-cursors
- :skip-variants '(xata cratedb cockroachdb risingwave questdb
greptimedb ydb materialize spanner octodb))
+ :skip-variants '(xata cratedb cockroachdb risingwave questdb
greptimedb ydb materialize spanner octodb cedardb))
;; CrateDB does not support the BYTEA type (!), nor sequences. Spanner
does not support the encode() function.
(pgtest-add #'pg-test-bytea
:skip-variants '(cratedb risingwave spanner materialize))
@@ -306,16 +318,16 @@
(pgtest-add #'pg-test-array
:skip-variants '(cratedb risingwave questdb materialize
clickhouse octodb))
(pgtest-add #'pg-test-enums
- :skip-variants '(cratedb risingwave questdb greptimedb ydb
materialize spanner octodb clickhouse vertica))
+ :skip-variants '(cratedb risingwave questdb greptimedb ydb
materialize spanner octodb clickhouse vertica cedardb))
(pgtest-add #'pg-test-server-prepare
:skip-variants '(cratedb risingwave questdb greptimedb ydb
octodb))
(pgtest-add #'pg-test-comments
- :skip-variants '(ydb cratedb cockroachdb spanner questdb
thenile))
+ :skip-variants '(ydb cratedb cockroachdb spanner questdb
thenile cedardb))
(pgtest-add #'pg-test-metadata
:skip-variants '(cratedb cockroachdb risingwave materialize
questdb greptimedb ydb spanner vertica))
;; CrateDB doesn't support the JSONB type. CockroachDB doesn't support
casting to JSON.
(pgtest-add #'pg-test-json
- :skip-variants '(xata cratedb risingwave questdb greptimedb
ydb materialize spanner octodb vertica))
+ :skip-variants '(xata cratedb risingwave questdb greptimedb
ydb materialize spanner octodb vertica cedardb))
(pgtest-add #'pg-test-schemas
:skip-variants '(xata cratedb risingwave questdb ydb
materialize))
(pgtest-add #'pg-test-hstore
@@ -325,11 +337,11 @@
(pgtest-add #'pg-test-vector
:skip-variants '(xata cratedb materialize octodb vertica))
(pgtest-add #'pg-test-tsvector
- :skip-variants '(xata cratedb cockroachdb risingwave questdb
greptimedb ydb materialize spanner octodb vertica))
+ :skip-variants '(xata cratedb cockroachdb risingwave questdb
greptimedb ydb materialize spanner octodb vertica cedardb))
(pgtest-add #'pg-test-bm25
:skip-variants '(xata cratedb cockroachdb risingwave
materialize octodb vertica))
(pgtest-add #'pg-test-geometric
- :skip-variants '(xata cratedb cockroachdb risingwave questdb
materialize spanner octodb vertica))
+ :skip-variants '(xata cratedb cockroachdb risingwave questdb
materialize spanner octodb vertica cedardb))
(pgtest-add #'pg-test-gis
:skip-variants '(xata cratedb cockroachdb risingwave
materialize octodb))
(pgtest-add #'pg-test-copy
@@ -342,7 +354,7 @@
:skip-variants '(xata cratedb questdb ydb vertica))
;; Many PostgreSQL variants only support UTF8 as the client encoding.
(pgtest-add #'pg-test-client-encoding
- :skip-variants '(cratedb cockroachdb ydb risingwave
materialize spanner greptimedb xata vertica))
+ :skip-variants '(cratedb cockroachdb ydb risingwave
materialize spanner greptimedb questdb xata vertica))
(pgtest-add #'pg-test-unicode-names
:skip-variants '(xata cratedb cockroachdb risingwave questdb
ydb spanner vertica))
(pgtest-add #'pg-test-returning
@@ -354,11 +366,13 @@
;; than returning a more granular error code.
(pgtest-add #'pg-test-error-sqlstate
:skip-variants '(cratedb risingwave))
- (pgtest-add #'pg-test-notice)
+ ;; As of 2025-08, CedarDB does not implement DO.
+ (pgtest-add #'pg-test-notice
+ :skip-variants '(cedardb))
(pgtest-add #'pg-test-notify
- :skip-variants '(cratedb cockroachdb risingwave materialize
greptimedb ydb questdb spanner vertica))
+ :skip-variants '(cratedb cockroachdb risingwave materialize
greptimedb ydb questdb spanner vertica cedardb))
(pgtest-add #'pg-test-lo
- :skip-variants '(cratedb cockroachdb risingwave materialize
greptimedb ydb questdb spanner vertica greenplum))
+ :skip-variants '(cratedb cockroachdb risingwave materialize
greptimedb ydb questdb spanner vertica greenplum cedardb))
(dolist (test (reverse tests))
(message "== Running test %s" test)
(condition-case err
@@ -423,10 +437,9 @@
(defun pg-test-prepared (con)
(cl-labels ((row (query args) (pg-result (pg-exec-prepared con query args)
:tuple 0))
- (scalar (query args) (car (row query args)))
- (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5)))
+ (scalar (query args) (car (row query args))))
(should (equal 42 (scalar "SELECT 42" (list))))
- (should (approx= 42.0 (scalar "SELECT 42.00" (list))))
+ (should (pgtest-approx= 42.0 (scalar "SELECT 42.00" (list))))
(should (equal nil (scalar "SELECT NULL" (list))))
(unless (member (pgcon-server-variant con) '(immudb))
(should (equal (list t nil) (row "SELECT $1, $2" `((t . "bool") (nil .
"bool")))))
@@ -443,6 +456,7 @@
;; https://github.com/kagis/pgwire/blob/main/test/test.js
(let ((typ (scalar "SELECT pg_typeof($1)::text" '((42 . "int4")))))
(should (or (string= "integer" typ)
+ (string= "int4" typ)
(string= "bigint" typ))))
(let ((typs (row "SELECT pg_typeof($1)::text, $1::text" '(("foobles" .
"text")))))
(should (string= "foobles" (cl-second typs)))
@@ -476,12 +490,12 @@
(should (eql 42 (scalar "SELECT $1 + 142" '((-100 . "int4")))))
(should (eql 42 (scalar "SELECT $1 + 1" '((41 . "int8")))))
(should (eql 42 (scalar "SELECT $1 + 142" '((-100 . "int8")))))
- (should (approx= -55.0 (scalar "SELECT $1" '((-55.0 . "float4")))))
- (should (approx= -55.0 (scalar "SELECT $1" '((-55.0 . "float8")))))
- (should (approx= 42.0 (scalar "SELECT $1 + 1" '((41.0 . "float4")))))
- (should (approx= 42.0 (scalar "SELECT $1 + 85.0" '((-43.0 . "float4")))))
- (should (approx= 42.0 (scalar "SELECT $1 + 1" '((41.0 . "float8")))))
- (should (approx= 42.0 (scalar "SELECT $1 + 85" '((-43.0 . "float8")))))
+ (should (pgtest-approx= -55.0 (scalar "SELECT $1" '((-55.0 . "float4")))))
+ (should (pgtest-approx= -55.0 (scalar "SELECT $1" '((-55.0 . "float8")))))
+ (should (pgtest-approx= 42.0 (scalar "SELECT $1 + 1" '((41.0 .
"float4")))))
+ (should (pgtest-approx= 42.0 (scalar "SELECT $1 + 85.0" '((-43.0 .
"float4")))))
+ (should (pgtest-approx= 42.0 (scalar "SELECT $1 + 1" '((41.0 .
"float8")))))
+ (should (pgtest-approx= 42.0 (scalar "SELECT $1 + 85" '((-43.0 .
"float8")))))
(unless (member (pgcon-server-variant con) '(cratedb risingwave))
;; CrateDB returns an incorrect value ?8 here
(should (eql ?Q (scalar "SELECT $1" '((?Q . "char"))))))
@@ -517,14 +531,14 @@
;; Risingwave does not support casting to JSON.
(unless (member (pgcon-server-variant con) '(risingwave materialize))
(let ((json (scalar "SELECT $1::json" '(("[66.7,-42.0,8]" . "text")))))
- (should (approx= 66.7 (aref json 0)))
- (should (approx= -42.0 (aref json 1)))))
+ (should (pgtest-approx= 66.7 (aref json 0)))
+ (should (pgtest-approx= -42.0 (aref json 1)))))
;; CrateDB does not support the JSONB type, not casting {foo=bar} syntax
to JSON. CockroachDB
;; supports JSONB but not JSON.
(unless (member (pgcon-server-variant con) '(cratedb cockroachdb
risingwave materialize))
(let ((json (scalar "SELECT $1::jsonb" '(("[66.7,-42.0,8]" . "text")))))
- (should (approx= 66.7 (aref json 0)))
- (should (approx= -42.0 (aref json 1))))
+ (should (pgtest-approx= 66.7 (aref json 0)))
+ (should (pgtest-approx= -42.0 (aref json 1))))
(let ((json (scalar "SELECT $1::jsonb" '(("[5,7]" . "text")))))
(should (eql 5 (aref json 0))))
(let* ((ht (make-hash-table :test #'equal))
@@ -603,7 +617,6 @@
(should (eql (cl-first tuple) (cl-incf counter)))))
(should (eql counter rows))
(pg-close-portal con portal))
- (message "multiple fetch/suspend portal test complete")
;; check for unexpected pending messages in the stream (problem with old
PostgreSQL versions)
(let* ((res (pg-exec con "SELECT 55"))
(tuple (pg-result res :tuple 0)))
@@ -758,7 +771,8 @@ bar$$"))))
(defun pg-test-insert (con)
- (cl-flet ((scalar (sql) (cl-first (pg-result (pg-exec con sql) :tuple 0))))
+ (cl-flet ((scalar (sql) (cl-first (pg-result (pg-exec con sql) :tuple 0)))
+ (random-word () (apply #'string (cl-loop for count to 15 collect
(+ ?a (random 26))))))
(let ((count 100))
(when (pgtest-have-table con "count_test")
(pg-exec con "DROP TABLE count_test"))
@@ -804,7 +818,28 @@ bar$$"))))
(pgtest-flush-table con "w")
(let ((res (pg-exec con "SELECT * FROM w")))
(should (eql 3 (length (pg-result res :tuples)))))
- (pg-exec con "DROP TABLE w"))))
+ (pg-exec con "DROP TABLE w"))
+ ;; Testing insert via UNNEST
+ (when-let* ((sql (pgtest-massage con "CREATE TABLE measurement(
+ id SERIAL PRIMARY KEY,
+ sensorid TEXT,
+ value FLOAT8,
+ ts TIMESTAMPTZ DEFAULT current_timestamp)")))
+ (pg-exec con "DROP TABLE IF EXISTS measurement")
+ (pg-exec con sql)
+ (let* ((size 30) ;; 9988
+ (sensors (make-vector size nil))
+ (values (make-vector size 0.0))
+ (sql "INSERT INTO measurement(sensorid,value) SELECT * FROM
unnest($1::text[], $2::float8[])"))
+ (dotimes (i size)
+ (setf (aref sensors i) (random-word))
+ (setf (aref values i) (cl-random 1000.0)))
+ (pg-exec-prepared con sql
+ `((,sensors . "_text") (,values . "_float8")))
+ (let* ((res (pg-exec con "SELECT COUNT(*) FROM measurement"))
+ (row (pg-result res :tuple 0)))
+ (should (eql size (cl-first row))))
+ (pg-exec con "DROP TABLE measurement")))))
(defun pg-test-insert/prepared (con)
(cl-flet ((scalar (sql) (cl-first (pg-result (pg-exec con sql) :tuple 0))))
@@ -824,7 +859,88 @@ bar$$"))))
(should (eql count (scalar "SELECT COUNT(*) FROM count_test")))
(should (eql (/ (* (1- count) count) 2) (scalar "SELECT sum(key) FROM
count_test")))
(pg-exec con "DROP TABLE count_test"))
- (should (not (pgtest-have-table con "count_test"))))))
+ (should (not (pgtest-have-table con "count_test")))
+ ;; Now test the serialization functions for array types
+ (when (pgtest-have-table con "sarray")
+ (pg-exec con "DROP TABLE sarray"))
+ (when-let* ((sql (pgtest-massage con "CREATE TABLE sarray(id SERIAL
PRIMARY KEY, val int2)")))
+ (pg-exec con sql)
+ (let* ((size 203)
+ (values (make-vector size nil))
+ (sql "INSERT INTO sarray(val) SELECT * FROM
unnest($1::int2[])"))
+ (dotimes (i size)
+ (setf (aref values i) i))
+ (pg-exec-prepared con sql `((,values . "_int2")))
+ (let* ((res (pg-exec con "SELECT val FROM sarray ORDER BY val"))
+ (rows (pg-result res :tuples)))
+ (dotimes (i size)
+ (should (eql i (cl-first (nth i rows)))))))
+ (pg-exec con "DROP TABLE sarray"))
+ (when-let* ((sql (pgtest-massage con "CREATE TABLE sarray(id SERIAL
PRIMARY KEY, val int4)")))
+ (pg-exec con sql)
+ (let* ((size 203)
+ (values (make-vector size nil))
+ (sql "INSERT INTO sarray(val) SELECT * FROM
unnest($1::int4[])"))
+ (dotimes (i size)
+ (setf (aref values i) i))
+ (pg-exec-prepared con sql `((,values . "_int4")))
+ (let* ((res (pg-exec con "SELECT val FROM sarray ORDER BY val"))
+ (rows (pg-result res :tuples)))
+ (dotimes (i size)
+ (should (eql i (cl-first (nth i rows)))))))
+ (pg-exec con "DROP TABLE sarray"))
+ (when-let* ((sql (pgtest-massage con "CREATE TABLE sarray(id SERIAL
PRIMARY KEY, val int8)")))
+ (pg-exec con sql)
+ (let* ((size 403)
+ (values (make-vector size nil))
+ (sql "INSERT INTO sarray(val) SELECT * FROM
unnest($1::int8[])"))
+ (dotimes (i size)
+ (setf (aref values i) (- i)))
+ (pg-exec-prepared con sql `((,values . "_int8")))
+ (let* ((res (pg-exec con "SELECT val FROM sarray ORDER BY val DESC"))
+ (rows (pg-result res :tuples)))
+ (dotimes (i size)
+ (should (eql (- i) (cl-first (nth i rows)))))))
+ (pg-exec con "DROP TABLE sarray"))
+ (when-let* ((sql (pgtest-massage con "CREATE TABLE sarray(id SERIAL
PRIMARY KEY, val float4)")))
+ (pg-exec con sql)
+ (let* ((size 103)
+ (values (make-vector size nil))
+ (sql "INSERT INTO sarray(val) SELECT * FROM
unnest($1::float4[])"))
+ (dotimes (i size)
+ (setf (aref values i) i))
+ (pg-exec-prepared con sql `((,values . "_float4")))
+ (let* ((res (pg-exec con "SELECT val FROM sarray ORDER BY val"))
+ (rows (pg-result res :tuples)))
+ (dotimes (i size)
+ (should (pgtest-approx= i (cl-first (nth i rows)))))))
+ (pg-exec con "DROP TABLE sarray"))
+ (when-let* ((sql (pgtest-massage con "CREATE TABLE sarray(id SERIAL
PRIMARY KEY, val float8)")))
+ (pg-exec con sql)
+ (let* ((size 17)
+ (values (make-vector size nil))
+ (sql "INSERT INTO sarray(val) SELECT * FROM
unnest($1::float8[])"))
+ (dotimes (i size)
+ (setf (aref values i) i))
+ (pg-exec-prepared con sql `((,values . "_float8")))
+ (let* ((res (pg-exec con "SELECT val FROM sarray ORDER BY val"))
+ (rows (pg-result res :tuples)))
+ (dotimes (i size)
+ (should (pgtest-approx= i (cl-first (nth i rows)))))))
+ (pg-exec con "DROP TABLE sarray"))
+ (when-let* ((sql (pgtest-massage con "CREATE TABLE sarray(id SERIAL
PRIMARY KEY, val TEXT)")))
+ (pg-exec con sql)
+ (let* ((size 17)
+ (values (make-vector size nil))
+ (sql "INSERT INTO sarray(val) SELECT * FROM
unnest($1::text[])"))
+ (dotimes (i size)
+ (setf (aref values i) (format "%04d-value" i)))
+ (pg-exec-prepared con sql `((,values . "_text")))
+ (let* ((res (pg-exec con "SELECT val FROM sarray ORDER BY val"))
+ (rows (pg-result res :tuples)))
+ (dotimes (i size)
+ (should (string= (format "%04d-value" i) (cl-first (nth i
rows)))))))
+ (pg-exec con "DROP TABLE sarray")))))
;; Check the mixing of prepared queries, cached prepared statements, normal
simple queries, to check
;; that the cache works as expected and that the backend retains prepared
statements. TODO: should
@@ -1040,8 +1156,7 @@ bar$$"))))
(encode-time (list 6 5 4 3 2 2001 nil -1 nil)))))))
(defun pg-test-numeric (con)
- (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))
- (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5)))
+ (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))))
(should (eql -1 (scalar "SELECT '-1'::int")))
(should (eql 128 (scalar "SELECT 128::int2")))
(should (eql -5 (scalar "SELECT -5::int2")))
@@ -1054,7 +1169,7 @@ bar$$"))))
(should (eql 0 (scalar "SELECT (-32768)::int2 % (-1)::int2")))
;; RisingWave doesn't support numeric(x, y) or decimal(x, y).
(unless (member (pgcon-server-variant con) '(risingwave questdb))
- (should (approx= 3.14 (scalar "SELECT 3.14::decimal(10,2) as pi"))))
+ (should (pgtest-approx= 3.14 (scalar "SELECT 3.14::decimal(10,2) as
pi"))))
;; CrateDB doesn't support the OID type, nor casting integers to bits.
(unless (member (pgcon-server-variant con) '(cratedb risingwave
materialize octodb))
(should (eql 123 (scalar "SELECT 123::oid")))
@@ -1084,20 +1199,20 @@ bar$$"))))
(should (eql (scalar "SELECT trunc(43.3)") 43))
(should (eql (scalar "SELECT trunc(-42.3)") -42)))
(unless (member (pgcon-server-variant con) '(cockroachdb))
- (should (approx= (scalar "SELECT log(100)") 2))
+ (should (pgtest-approx= (scalar "SELECT log(100)") 2))
;; bignums only supported from Emacs 27.2 onwards
(unless (member (pgcon-server-variant con) '(cratedb risingwave
materialize))
(when (fboundp 'bignump)
(should (eql (scalar "SELECT factorial(25)")
15511210043330985984000000)))))
(unless (member (pgcon-server-variant con) '(materialize))
- (should (approx= (scalar "SELECT pi()") 3.1415626)))
- (should (approx= (scalar "SELECT -5.0") -5.0))
- (should (approx= (scalar "SELECT 5e-14") 5e-14))
- (should (approx= (scalar "SELECT 55.678::float4") 55.678))
- (should (approx= (scalar "SELECT 55.678::float8") 55.678))
- (should (approx= (scalar "SELECT 55.678::real") 55.678))
- (should (approx= (scalar "SELECT 55.678::numeric") 55.678))
- (should (approx= (scalar "SELECT -1000000000.123456789")
-1000000000.123456789))
+ (should (pgtest-approx= (scalar "SELECT pi()") 3.1415626)))
+ (should (pgtest-approx= (scalar "SELECT -5.0") -5.0))
+ (should (pgtest-approx= (scalar "SELECT 5e-14") 5e-14))
+ (should (pgtest-approx= (scalar "SELECT 55.678::float4") 55.678))
+ (should (pgtest-approx= (scalar "SELECT 55.678::float8") 55.678))
+ (should (pgtest-approx= (scalar "SELECT 55.678::real") 55.678))
+ (should (pgtest-approx= (scalar "SELECT 55.678::numeric") 55.678))
+ (should (pgtest-approx= (scalar "SELECT -1000000000.123456789")
-1000000000.123456789))
(should (eql 1.0e+INF (scalar "SELECT 'Infinity'::float4")))
(should (eql -1.0e+INF (scalar "SELECT '-Infinity'::float4")))
(should (eql 1.0e+INF (scalar "SELECT 'Infinity'::float8")))
@@ -1106,7 +1221,7 @@ bar$$"))))
(should (isnan (scalar "SELECT 'NaN'::float8")))
;; The cube root operator
(unless (member (pgcon-server-variant con) '(cratedb materialize))
- (should (approx= 3.0 (scalar "SELECT ||/ float8 '27'"))))
+ (should (pgtest-approx= 3.0 (scalar "SELECT ||/ float8 '27'"))))
(should (string= (scalar "SELECT 42::decimal::text") "42"))
(unless (member (pgcon-server-variant con) '(cratedb cockroachdb
risingwave materialize))
(should (string= (scalar "SELECT macaddr '08002b:010203'")
"08:00:2b:01:02:03")))
@@ -1123,8 +1238,7 @@ bar$$"))))
(should (eql (scalar "SELECT date '2001-10-01' - date '2001-09-28'")
3)))))
(defun pg-test-numeric-range (con)
- (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))
- (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5)))
+ (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))))
(should (equal (list :range ?\[ 10 ?\) 20) (scalar "SELECT int4range(10,
20)")))
(should (equal (list :range ?\[ -4 ?\) 6) (scalar "SELECT int8range(-4,
6)")))
(should (equal (list :range ?\[ 5 ?\) 20) (scalar "SELECT int4range(5,15)
+ int4range(10,20)")))
@@ -1138,17 +1252,17 @@ bar$$"))))
(let ((range (scalar "SELECT numrange(33.33, 66.66)")))
(should (eql :range (nth 0 range)))
(should (eql ?\[ (nth 1 range)))
- (should (approx= 33.33 (nth 2 range)))
+ (should (pgtest-approx= 33.33 (nth 2 range)))
(should (eql ?\) (nth 3 range)))
- (should (approx= 66.66 (nth 4 range))))
- (should (approx= -40.0 (scalar "SELECT upper(numrange(-50.0,-40.00))")))
+ (should (pgtest-approx= 66.66 (nth 4 range))))
+ (should (pgtest-approx= -40.0 (scalar "SELECT
upper(numrange(-50.0,-40.00))")))
;; range is unbounded on lower side
(let ((range (scalar "SELECT numrange(NULL, 2.2)")))
(should (eql :range (nth 0 range)))
(should (eql ?\( (nth 1 range)))
(should (eql nil (nth 2 range)))
(should (eql ?\) (nth 3 range)))
- (should (approx= 2.2 (nth 4 range))))
+ (should (pgtest-approx= 2.2 (nth 4 range))))
(should (equal (list :range ?\[ 42 ?\) nil) (scalar "SELECT
int8range(42,NULL)")))
(should (equal (list :range ?\( nil ?\) nil) (scalar "SELECT
numrange(NULL, NULL)")))))
@@ -1266,16 +1380,36 @@ bar$$"))))
(cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))))
(pg-exec con "DROP SEQUENCE IF EXISTS foo_seq")
(pg-exec con "CREATE SEQUENCE IF NOT EXISTS foo_seq INCREMENT 20 START
WITH 400")
- (should (equal 400 (scalar "SELECT nextval('foo_seq')")))
+ (should (eql 400 (scalar "SELECT nextval('foo_seq')")))
(unless (member (pgcon-server-variant con) '(yugabyte))
- (should (equal 400 (scalar "SELECT last_value FROM pg_sequences WHERE
sequencename='foo_seq'"))))
- (should (equal 420 (scalar "SELECT nextval('foo_seq')")))
- (should (equal 440 (scalar "SELECT nextval('foo_seq')")))
- (pg-exec con "DROP SEQUENCE foo_seq")))
+ (should (eql 400 (scalar "SELECT last_value FROM pg_sequences WHERE
sequencename='foo_seq'"))))
+ (should (eql 420 (scalar "SELECT nextval('foo_seq')")))
+ (should (eql 440 (scalar "SELECT nextval('foo_seq')")))
+ (pg-exec con "DROP SEQUENCE foo_seq")
+ (pg-exec con "DROP SEQUENCE IF EXISTS test_seq_nocycle")
+ (pg-exec con "CREATE SEQUENCE test_seq_nocycle START 1 INCREMENT 1
MAXVALUE 2 NO CYCLE")
+ (should (eql 1 (scalar "SELECT nextval('test_seq_nocycle')")))
+ (should (eql 2 (scalar "SELECT nextval('test_seq_nocycle')")))
+ (should (eql 'ok (condition-case nil
+ (scalar "SELECT nextval('test_seq_nocycle')")
+ (pg-sequence-limit-exceeded 'ok))))
+ (pg-exec con "DROP SEQUENCE test_seq_nocycle")
+ (pg-exec con "DROP SEQUENCE IF EXISTS test_seq_cycle")
+ (pg-exec con "CREATE SEQUENCE test_seq_cycle START 1 INCREMENT 1 MAXVALUE
2 CYCLE")
+ (should (eql 1 (scalar "SELECT nextval('test_seq_cycle')")))
+ (should (eql 2 (scalar "SELECT nextval('test_seq_cycle')")))
+ ;; should cycle
+ (should (eql 1 (scalar "SELECT nextval('test_seq_cycle')")))
+ (pg-exec con "DROP SEQUENCE test_seq_cycle")
+ (pg-exec con "DROP SEQUENCE IF EXISTS test_seq_setval")
+ (pg-exec con "CREATE SEQUENCE test_seq_setval")
+ (should (eql 50 (scalar "SELECT setval('test_seq_setval', 50)")))
+ (should (eql 50 (scalar "SELECT currval('test_seq_setval')")))
+ (should (eql 51 (scalar "SELECT nextval('test_seq_setval')")))
+ (pg-exec con "DROP SEQUENCE test_seq_setval")))
(defun pg-test-array (con)
- (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))
- (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5)))
+ (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))))
(should (equal (vector 7 8) (scalar "SELECT ARRAY[7,8]")))
(should (equal (vector 9 10 11) (scalar "SELECT '{9,10,11}'::int[]")))
(should (equal (vector 1234) (scalar "SELECT ARRAY[1234::int2]")))
@@ -1293,10 +1427,10 @@ bar$$"))))
(should (equal (vector) (scalar "SELECT '{}'::float8[]")))
(let ((vec (scalar "SELECT ARRAY[3.14::float]")))
(should (floatp (aref vec 0)))
- (should (approx= 3.14 (aref vec 0))))
+ (should (pgtest-approx= 3.14 (aref vec 0))))
(let ((vec (scalar "SELECT ARRAY[CAST(3.14 AS DOUBLE PRECISION)]")))
(should (floatp (aref vec 0)))
- (should (approx= 3.14 (aref vec 0))))
+ (should (pgtest-approx= 3.14 (aref vec 0))))
(should (equal (vector 4 20) (scalar "SELECT ARRAY[4] || 20")))
(should (eql 6 (scalar "SELECT array_length('{1,2,3,4,5,6}'::int4[], 1)")))
(should (equal (vector 42) (scalar "SELECT array_agg(42)")))
@@ -1314,8 +1448,8 @@ bar$$"))))
;; (should (equal (vector 1 2 3) (cl-first row))))
(let ((vec (scalar "SELECT ARRAY[44.3, 8999.5]")))
(should (equal 2 (length vec)))
- (should (approx= 44.3 (aref vec 0)))
- (should (approx= 8999.5 (aref vec 1))))))
+ (should (pgtest-approx= 44.3 (aref vec 0)))
+ (should (pgtest-approx= 8999.5 (aref vec 1))))))
;; TODO: we do not currently handle multidimension arrays correctly
;; (should (equal (vector (vector 4 5) (vector 6 7))
@@ -1367,7 +1501,7 @@ bar$$"))))
(pg-exec con "DROP SCHEMA pgeltestschema")))
(defun pg-test-metadata (con)
- (unless (member (pgcon-server-variant con) '(xata))
+ (unless (member (pgcon-server-variant con) '(xata cedardb))
(pg-exec con "SET work_mem TO '2MB'")
(pg-exec con "EXPLAIN (COSTS OFF) SELECT 42")
(pg-exec con "RESET work_mem"))
@@ -1540,8 +1674,7 @@ bar$$"))))
;; https://www.postgresql.org/docs/15/functions-json.html
(defun pg-test-json (con)
- (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))
- (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5)))
+ (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))))
(should (eql 42 (scalar "SELECT to_json(42)")))
(should (eql -56 (scalar "SELECT CAST ('-56' as json)")))
(should (eql nil (scalar "SELECT JSON(NULL)")))
@@ -1550,7 +1683,7 @@ bar$$"))))
(should (eql 1 (gethash "a" dct))))
(unless (member (pgcon-server-variant con) '(alloydb))
(when (>= (pgcon-server-version-major con) 17)
- (should (approx= 155.6 (scalar "SELECT json_scalar(155.6)")))
+ (should (pgtest-approx= 155.6 (scalar "SELECT json_scalar(155.6)")))
(should (string= "155.6" (scalar "SELECT json_scalar('155.6')")))
(should (string= "144" (scalar "SELECT json_serialize('144')")))))
(let ((json (scalar "SELECT '[5,7]'::json")))
@@ -1558,11 +1691,11 @@ bar$$"))))
(let ((json (scalar "SELECT '[5,7]'::jsonb")))
(should (eql 5 (aref json 0))))
(let ((json (scalar "SELECT '[66.7,-42.0,8]'::json")))
- (should (approx= 66.7 (aref json 0)))
- (should (approx= -42.0 (aref json 1))))
+ (should (pgtest-approx= 66.7 (aref json 0)))
+ (should (pgtest-approx= -42.0 (aref json 1))))
(let ((json (scalar "SELECT '[66.7,-42.0,8]'::jsonb")))
- (should (approx= 66.7 (aref json 0)))
- (should (approx= -42.0 (aref json 1))))
+ (should (pgtest-approx= 66.7 (aref json 0)))
+ (should (pgtest-approx= -42.0 (aref json 1))))
;; JSON null in JSONB type is not the same as PostgreSQL NULL value!
(should (eql nil (scalar "SELECT 'null'::jsonb is null")))
(should (eql nil (scalar "SELECT '{\"name\": null}'::jsonb->'name' IS
NULL")))
@@ -1709,8 +1842,10 @@ bar$$"))))
;; Testing support for the pgvector extension.
(defun pg-test-vector (con)
- (when (pg-vector-setup con)
- (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))))
+ (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))))
+ (pg-vector-setup con)
+ (unless (zerop (scalar "SELECT COUNT(*) FROM pg_type WHERE
typname='vector'"))
+ (message "Testing pgvector support")
(let ((v (scalar "SELECT '[4,5,6]'::vector")))
(should (eql 4 (aref v 0))))
(let ((v (scalar "SELECT '[0.003,0.004,1.567,6.777]'::vector")))
@@ -1722,6 +1857,18 @@ bar$$"))))
(should (eql 5 d)))
(let ((d (scalar "SELECT cosine_distance('[1,2]'::vector, '[0,0]')")))
(should (eql 0.0e+NaN d)))
+ (let ((d (scalar "SELECT '[1,2,3]'::vector <+> '[4,5,6]'::vector")))
+ (should (eql 9 d)))
+ (let ((d (scalar "SELECT l1_distance('[1,2,3]'::vector,
'[4,5,6]'::vector)")))
+ (should (eql 9 d)))
+ (let ((d (scalar "SELECT '[1,1,1,1]'::vector <=> '[2,2,2,2]'::vector")))
+ (should (eql 0 d)))
+ (let ((d (scalar "SELECT cosine_distance('[1,1,1,1]'::vector,
'[2,2,2,2]'::vector)")))
+ (should (eql 0 d)))
+ (let ((d (scalar "SELECT '[1,2,3]'::vector <#> '[4,5,6]'::vector")))
+ (should (eql -32 d)))
+ (let ((d (scalar "SELECT inner_product('[1,2,3]'::vector,
'[4,5,6]'::vector)")))
+ (should (eql 32 d)))
(when (pg-function-p con "gen_random_uuid")
(pg-exec con "DROP TABLE IF EXISTS items")
(let ((sql (pgtest-massage con "CREATE TABLE items (
@@ -1820,8 +1967,7 @@ bar$$"))))
(defun pg-test-geometric (con)
(cl-labels ((row (query args) (pg-result (pg-exec-prepared con query args)
:tuple 0))
- (scalar (query args) (car (row query args)))
- (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5)))
+ (scalar (query args) (car (row query args))))
(pg-geometry-setup con)
(let* ((raw "(45.6,67) ")
(p1 (pg--point-parser "(45.6,67) " nil)))
@@ -1833,7 +1979,7 @@ bar$$"))))
(should (floatp (cdr p3)))
(should (<= -10 (cdr p3) -9)))
(let ((p4 (pg--point-parser "(33e4, -3.1456e4)" nil)))
- (should (approx= 33e4 (car p4)))
+ (should (pgtest-approx= 33e4 (car p4)))
(should (<= -35000 (cdr p4) 31000)))
(let ((p5 (pg--point-parser "(a,b)" nil)))
(should (eql nil p5)))
@@ -1842,7 +1988,7 @@ bar$$"))))
(should (eql 3 (car p7)))
(should (eql 4 (cdr p7))))
(let ((p8 (pg--point-parser "(12.1,4e-4) " nil)))
- (should (approx= 4 (* 1e4 (cdr p8)))))
+ (should (pgtest-approx= 4 (* 1e4 (cdr p8)))))
(let ((p9 (pg--point-parser " (55,7866677)" nil)))
(should (eql 55 (car p9))))
(let ((p10 (pg--point-parser "(22.6,6) " nil)))
@@ -1850,7 +1996,7 @@ bar$$"))))
(let ((point (scalar "SELECT '(82,91.0)'::point" nil)))
(should (consp point))
(should (eql 82 (car point)))
- (should (approx= 91.0 (cdr point))))
+ (should (pgtest-approx= 91.0 (cdr point))))
(when (pg-function-p con "gen_random_uuid")
(pg-exec con "DROP TABLE IF EXISTS with_point")
(pg-exec con (pgtest-massage con "CREATE TABLE with_point(
@@ -1905,7 +2051,7 @@ bar$$"))))
(pg-exec con "DROP TABLE with_line")
(let ((lseg (pg--lseg-parser " [(4,5), (6.7, 4e1)]" nil)))
(should (eql 4 (car (aref lseg 0))))
- (should (approx= 4e1 (cdr (aref lseg 1)))))
+ (should (pgtest-approx= 4e1 (cdr (aref lseg 1)))))
(pg-exec con "DROP TABLE IF EXISTS with_lseg")
(pg-exec con (pgtest-massage con "CREATE TABLE with_lseg(
id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY,
@@ -1916,7 +2062,7 @@ bar$$"))))
(ls (cl-first (pg-result res :tuple 0))))
(should (eql 2 (car (aref ls 0))))
(should (eql 3 (cdr (aref ls 0))))
- (should (approx= 55.5 (car (aref ls 1)))))
+ (should (pgtest-approx= 55.5 (car (aref ls 1)))))
(pg-exec con "DROP TABLE with_lseg")
(let ((box (pg--box-parser "(4,5), (-66,-77e0) " nil)))
(should (eql 4 (car (aref box 0))))
@@ -1930,9 +2076,9 @@ bar$$"))))
(res (pg-exec-prepared con "SELECT $1" `((,bx . "box"))))
(bx (cl-first (pg-result res :tuple 0))))
;; the box corners are output in the order upper-right, lower-left
- (should (approx= 55.6 (car (aref bx 0))))
+ (should (pgtest-approx= 55.6 (car (aref bx 0))))
(should (eql 3 (cdr (aref bx 0))))
- (should (approx= -23.2 (cdr (aref bx 1)))))
+ (should (pgtest-approx= -23.2 (cdr (aref bx 1)))))
(pg-exec con "DROP TABLE with_box")
(let* ((path (pg--path-parser "[(4,5),(6,7), (55e1,66.1),(0,0) ]" nil))
(points (pg-geometry-path-points path)))
@@ -1973,14 +2119,13 @@ bar$$"))))
(points (pg-geometry-polygon-points pg)))
(should (eql 4 (length points)))
(should (eql 3 (cdr (cl-first points))))
- (should (approx= 7.77 (cdr (car (last points))))))
+ (should (pgtest-approx= 7.77 (cdr (car (last points))))))
(pg-exec con "DROP TABLE with_polygon"))))
;; PostGIS parsing tests. These tests require the geosop commandline utility
to be installed.
(defun pg-test-gis (con)
(cl-labels ((row (query) (pg-result (pg-exec con query) :tuple 0))
- (scalar (query) (car (row query)))
- (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5)))
+ (scalar (query) (car (row query))))
(when (pg-setup-postgis con)
(message "Testing PostGIS support...")
(let* ((res (pg-exec con "SELECT 'SRID=4326;POINT(0 0)'::geometry"))
@@ -2143,8 +2288,9 @@ bar$$"))))
(should (string= "UPDATE 1" (pg-result r5 :status)))
(should (string= "foob" (car (pg-result r6 :tuple 0))))
(message "status of DROP is %s" (pg-result r7 :status))
+ ;; With PostgreSQL the status is "DROP TABLE"; with CedarDB it is "DROP".
(unless (member (pgcon-server-variant con) '(cratedb))
- (should (string= "DROP TABLE" (pg-result r7 :status))))
+ (should (string-prefix-p "DROP" (pg-result r7 :status))))
(should (eql (length (pg-result r8 :tuples)) 10))
(message "=============================================="))
(let ((res (pg-exec con "SELECT 1 UNION SELECT 2")))
@@ -2172,7 +2318,7 @@ bar$$"))))
(let ((res (pg-exec con "EXPLAIN ANALYZE SELECT 42")))
;; CrateDB returns "EXPLAIN 1". The output from EXPLAIN ANALYZE is
returned as a hash table.
(unless (member (pgcon-server-variant con) '(cratedb))
- (should (string= "EXPLAIN" (pg-result res :status)))
+ (should (string-prefix-p "EXPLAIN" (pg-result res :status)))
(should (cl-every (lambda (r) (stringp (car r))) (pg-result res
:tuples))))))
;; check query with empty column list
(unless (member (pgcon-server-variant con) '(cratedb))
@@ -2214,10 +2360,10 @@ bar$$"))))
(pg-exec con "CREATE INDEX idx_foobles ON foobles(a)")
(pg-exec con "INSERT INTO foobles VALUES (42, 'foo')")
(pg-exec con "INSERT INTO foobles VALUES (66, 'bizzle')")
- (unless (member (pgcon-server-variant con) '(risingwave materialize))
+ (unless (member (pgcon-server-variant con) '(risingwave materialize
cedardb))
(pg-exec con "REINDEX INDEX idx_foobles"))
(when (and (> (pgcon-server-version-major con) 11)
- (not (member (pgcon-server-variant con) '(risingwave greenplum
orioledb))))
+ (not (member (pgcon-server-variant con) '(risingwave greenplum
orioledb cedardb))))
(pg-exec con "REINDEX TABLE CONCURRENTLY foobles"))
(pg-exec con "DROP TABLE foobles"))
(let* ((r (pg-exec con "SHOW ALL"))
@@ -2549,6 +2695,14 @@ bar$$"))))
(should (eql 'ok (condition-case nil
(pg-exec con "PREPARE pgeltestq1(text, int, float,
boolean, smallint) AS SELECT 42")
(pg-duplicate-prepared-statement 'ok))))
+ (should (eql 'ok (condition-case nil
+ (progn
+ (pg-exec con "CREATE TABLE test_duplicate(a
INTEGER)")
+ (pg-exec con "CREATE TABLE test_duplicate(a
INTEGER)"))
+ (pg-duplicate-table 'ok))))
+ (should (eql 'ok (condition-case nil
+ (pg-exec con "CREATE TABLE duplicate_column(a
INTEGER, a INTEGER)")
+ (pg-duplicate-column 'ok))))
(should (eql 'ok (condition-case nil
(progn
(pg-exec con "PREPARE pgeltestq2(text, int, float,
boolean, smallint) AS SELECT 42")
@@ -2748,10 +2902,11 @@ bar$$"))))
(with-pg-transaction con
(let* ((oid (pg-lo-create con "rw"))
(fd (pg-lo-open con oid "rw")))
- (let* ((sql "SELECT oid FROM pg_catalog.pg_largeobject_metadata WHERE
oid=$1")
- (res (pg-exec-prepared con sql `((,oid . "int4"))))
- (rows (pg-result res :tuples)))
- (should (eql 1 (length rows))))
+ (unless (member (pgcon-server-variant con) '(yugabyte))
+ (let* ((sql "SELECT oid FROM pg_catalog.pg_largeobject_metadata WHERE
oid=$1")
+ (res (pg-exec-prepared con sql `((,oid . "int4"))))
+ (rows (pg-result res :tuples)))
+ (should (eql 1 (length rows)))))
(pg-lo-write con fd "Hi there mate")
(pg-lo-lseek con fd 3 pg-SEEK_SET)
(should (eql 3 (pg-lo-tell con fd)))
@@ -2813,12 +2968,13 @@ bar$$"))))
(defun pg-test-lo-import (con)
(message "Testing lo-import and friends")
(with-pg-transaction con
- (let* ((oid (pg-lo-import con "/etc/group"))
- (sql "SELECT oid FROM pg_catalog.pg_largeobject_metadata WHERE
oid=$1")
- (res (pg-exec-prepared con sql `((,oid . "int4"))))
- (rows (pg-result res :tuples)))
- (should (eql 1 (length rows)))
- (should (eql oid (caar rows)))
+ (let ((oid (pg-lo-import con "/etc/group")))
+ (unless (member (pgcon-server-variant con) '(yugabyte))
+ (let* ((sql "SELECT oid FROM pg_catalog.pg_largeobject_metadata WHERE
oid=$1")
+ (res (pg-exec-prepared con sql `((,oid . "int4"))))
+ (rows (pg-result res :tuples)))
+ (should (eql 1 (length rows)))
+ (should (eql oid (caar rows)))))
(pg-lo-export con oid "/tmp/group")
(cond ((zerop (call-process "diff" nil nil nil "/tmp/group"
"/etc/group"))
(message "lo-import test succeeded")
