2016-11-15 19:08:22 +01:00
|
|
|
|
;;; sql-tests.el --- Tests for sql.el -*- lexical-binding: t; -*-
|
|
|
|
|
|
2024-01-02 09:47:10 +08:00
|
|
|
|
;; Copyright (C) 2016-2024 Free Software Foundation, Inc.
|
2016-11-15 19:08:22 +01:00
|
|
|
|
|
|
|
|
|
;; Author: Simen Heggestøyl <simenheg@gmail.com>
|
|
|
|
|
;; Keywords:
|
|
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 15:52:52 -07:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2016-11-15 19:08:22 +01:00
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(require 'cl-lib)
|
|
|
|
|
(require 'ert)
|
Prefer ert-with-temp-(directory|file)
* test/lisp/abbrev-tests.el (read-write-abbrev-file-test)
(read-write-abbrev-file-test-with-props)
(abbrev-edit-save-to-file-test):
* test/lisp/auth-source-tests.el (auth-source-test-netrc-create-secret)
(auth-source-delete):
* test/lisp/autoinsert-tests.el (autoinsert-tests-auto-insert-file):
* test/lisp/bookmark-tests.el (with-bookmark-test-save-load):
* test/lisp/buff-menu-tests.el (buff-menu-24962):
* test/lisp/calendar/icalendar-tests.el (icalendar-tests--do-test-export):
* test/lisp/calendar/todo-mode-tests.el (with-todo-test):
* test/lisp/dired-tests.el
(dired-test-bug27243-01, dired-test-bug27243-02)
(dired-test-bug27243-03, dired-test-bug27631)
(dired-test-bug27968, dired-test-with-temp-dirs):
* test/lisp/dired-x-tests.el (dired-test-bug25942):
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file):
* test/lisp/emacs-lisp/check-declare-tests.el (check-declare-tests-scan)
(check-declare-tests-verify-mismatch):
* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-with-normal-env):
* test/lisp/emacs-lisp/package-tests.el (with-package-test)
(package-test-signed):
* test/lisp/emacs-lisp/testcover-tests.el (testcover-tests-markup-region)
(testcover-tests-run-test-case):
* test/lisp/emulation/viper-tests.el (viper-test-undo-kmacro):
* test/lisp/epg-tests.el (with-epg-tests):
* test/lisp/eshell/em-hist-tests.el (eshell-write-readonly-history):
* test/lisp/eshell/em-ls-tests.el (em-ls-test-bug27631):
* test/lisp/ffap-tests.el (ffap-tests-25243):
* test/lisp/files-tests.el (files-tests-bug-18141)
(files-tests-read-file-in-~, files-tests-make-directory)
(files-tests-copy-directory, files-tests-executable-find)
(files-tests-dont-rewrite-precious-files)
(files-tests--save-some-buffers):
* test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27631):
* test/lisp/mail/uudecode-tests.el (uudecode-tests-decode-region-internal)
(uudecode-tests-decode-region-external):
* test/lisp/net/browse-url-tests.el (browse-url-tests-delete-temp-file):
* test/lisp/progmodes/elisp-mode-tests.el (xref--case-insensitive):
* test/lisp/progmodes/etags-tests.el (etags-buffer-local-tags-table-list):
* test/lisp/progmodes/flymake-tests.el (ruby-backend):
* test/lisp/progmodes/python-tests.el (python-tests-with-temp-file):
* test/lisp/progmodes/sql-tests.el (with-sql-test-connect-harness):
* test/lisp/saveplace-tests.el (saveplace-test-save-place-to-alist/file)
(saveplace-test-forget-unreadable-files)
(saveplace-test-place-alist-to-file):
* test/lisp/so-long-tests/spelling-tests.el:
* test/lisp/textmodes/reftex-tests.el (reftex-locate-bibliography-files)
(reftex-parse-from-file-test):
* test/lisp/thumbs-tests.el (thumbs-tests-thumbsdir/create-if-missing):
* test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726)
(vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads):
* test/lisp/vc/diff-mode-tests.el (diff-mode-test-ignore-trailing-dashes):
* test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
* test/lisp/wdired-tests.el (wdired-test-bug32173-01)
(wdired-test-bug32173-02, wdired-test-symlink-name)
(wdired-test-unfinished-edit-01, wdired-test-bug34915)
(wdired-test-bug39280):
* test/src/buffer-tests.el (test-kill-buffer-auto-save-default):
* test/src/filelock-tests.el (filelock-tests--fixture):
* test/src/inotify-tests.el (inotify-file-watch-simple):
* test/src/undo-tests.el (undo-test-file-modified): Prefer
'ert-with-temp-(directory|file)' to using 'make-temp-file' directly.
In some cases, this is just cleanup, but in several cases this fixes
bugs where an error would have lead to us not cleaning up.
2021-11-06 23:20:59 +01:00
|
|
|
|
(require 'ert-x)
|
2016-11-15 19:08:22 +01:00
|
|
|
|
(require 'sql)
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-postgres-list-databases ()
|
|
|
|
|
"Test that output from `psql -ltX' is parsed correctly."
|
|
|
|
|
(cl-letf
|
|
|
|
|
(((symbol-function 'executable-find)
|
|
|
|
|
(lambda (_command) t))
|
|
|
|
|
((symbol-function 'process-lines)
|
|
|
|
|
(lambda (_program &rest _args)
|
|
|
|
|
'(" db-name-1 | foo-user | UTF8 | en_US.UTF-8 | en_US.UTF-8 | "
|
|
|
|
|
" db_name_2 | foo-user | UTF8 | en_US.UTF-8 | en_US.UTF-8 | "
|
|
|
|
|
""))))
|
|
|
|
|
(should (equal (sql-postgres-list-databases)
|
|
|
|
|
'("db-name-1" "db_name_2")))))
|
|
|
|
|
|
2017-08-09 15:34:34 +02:00
|
|
|
|
(ert-deftest sql-tests-postgres-list-databases-error ()
|
|
|
|
|
"Test that nil is returned when `psql -ltX' fails."
|
|
|
|
|
(cl-letf
|
|
|
|
|
(((symbol-function 'executable-find)
|
|
|
|
|
(lambda (_command) t))
|
|
|
|
|
((symbol-function 'process-lines)
|
|
|
|
|
(lambda (_program &rest _args)
|
2021-09-26 01:53:56 +02:00
|
|
|
|
(error "Some error"))))
|
2017-08-09 15:34:34 +02:00
|
|
|
|
(should-not (sql-postgres-list-databases))))
|
|
|
|
|
|
2019-02-20 22:13:51 -05:00
|
|
|
|
;;; Check Connection Password Handling/Wallet
|
|
|
|
|
|
2019-02-18 23:15:54 -05:00
|
|
|
|
(defvar sql-test-login-params nil)
|
|
|
|
|
(defmacro with-sql-test-connect-harness (id login-params connection expected)
|
|
|
|
|
"Set-up and tear-down SQL connect related test.
|
|
|
|
|
|
|
|
|
|
Identify tests by ID. Set :sql-login dialect attribute to
|
|
|
|
|
LOGIN-PARAMS. Provide the CONNECTION parameters and the EXPECTED
|
|
|
|
|
string of values passed to the comint function for validation."
|
|
|
|
|
(declare (indent 2))
|
Prefer ert-with-temp-(directory|file)
* test/lisp/abbrev-tests.el (read-write-abbrev-file-test)
(read-write-abbrev-file-test-with-props)
(abbrev-edit-save-to-file-test):
* test/lisp/auth-source-tests.el (auth-source-test-netrc-create-secret)
(auth-source-delete):
* test/lisp/autoinsert-tests.el (autoinsert-tests-auto-insert-file):
* test/lisp/bookmark-tests.el (with-bookmark-test-save-load):
* test/lisp/buff-menu-tests.el (buff-menu-24962):
* test/lisp/calendar/icalendar-tests.el (icalendar-tests--do-test-export):
* test/lisp/calendar/todo-mode-tests.el (with-todo-test):
* test/lisp/dired-tests.el
(dired-test-bug27243-01, dired-test-bug27243-02)
(dired-test-bug27243-03, dired-test-bug27631)
(dired-test-bug27968, dired-test-with-temp-dirs):
* test/lisp/dired-x-tests.el (dired-test-bug25942):
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file):
* test/lisp/emacs-lisp/check-declare-tests.el (check-declare-tests-scan)
(check-declare-tests-verify-mismatch):
* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-with-normal-env):
* test/lisp/emacs-lisp/package-tests.el (with-package-test)
(package-test-signed):
* test/lisp/emacs-lisp/testcover-tests.el (testcover-tests-markup-region)
(testcover-tests-run-test-case):
* test/lisp/emulation/viper-tests.el (viper-test-undo-kmacro):
* test/lisp/epg-tests.el (with-epg-tests):
* test/lisp/eshell/em-hist-tests.el (eshell-write-readonly-history):
* test/lisp/eshell/em-ls-tests.el (em-ls-test-bug27631):
* test/lisp/ffap-tests.el (ffap-tests-25243):
* test/lisp/files-tests.el (files-tests-bug-18141)
(files-tests-read-file-in-~, files-tests-make-directory)
(files-tests-copy-directory, files-tests-executable-find)
(files-tests-dont-rewrite-precious-files)
(files-tests--save-some-buffers):
* test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27631):
* test/lisp/mail/uudecode-tests.el (uudecode-tests-decode-region-internal)
(uudecode-tests-decode-region-external):
* test/lisp/net/browse-url-tests.el (browse-url-tests-delete-temp-file):
* test/lisp/progmodes/elisp-mode-tests.el (xref--case-insensitive):
* test/lisp/progmodes/etags-tests.el (etags-buffer-local-tags-table-list):
* test/lisp/progmodes/flymake-tests.el (ruby-backend):
* test/lisp/progmodes/python-tests.el (python-tests-with-temp-file):
* test/lisp/progmodes/sql-tests.el (with-sql-test-connect-harness):
* test/lisp/saveplace-tests.el (saveplace-test-save-place-to-alist/file)
(saveplace-test-forget-unreadable-files)
(saveplace-test-place-alist-to-file):
* test/lisp/so-long-tests/spelling-tests.el:
* test/lisp/textmodes/reftex-tests.el (reftex-locate-bibliography-files)
(reftex-parse-from-file-test):
* test/lisp/thumbs-tests.el (thumbs-tests-thumbsdir/create-if-missing):
* test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726)
(vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads):
* test/lisp/vc/diff-mode-tests.el (diff-mode-test-ignore-trailing-dashes):
* test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
* test/lisp/wdired-tests.el (wdired-test-bug32173-01)
(wdired-test-bug32173-02, wdired-test-symlink-name)
(wdired-test-unfinished-edit-01, wdired-test-bug34915)
(wdired-test-bug39280):
* test/src/buffer-tests.el (test-kill-buffer-auto-save-default):
* test/src/filelock-tests.el (filelock-tests--fixture):
* test/src/inotify-tests.el (inotify-file-watch-simple):
* test/src/undo-tests.el (undo-test-file-modified): Prefer
'ert-with-temp-(directory|file)' to using 'make-temp-file' directly.
In some cases, this is just cleanup, but in several cases this fixes
bugs where an error would have lead to us not cleaning up.
2021-11-06 23:20:59 +01:00
|
|
|
|
`(ert-with-temp-file tempfile
|
|
|
|
|
:suffix "sql-test-netrc"
|
|
|
|
|
:text (concat
|
|
|
|
|
"machine aMachine user aUserName password \"netrc-A aPassword\""
|
|
|
|
|
"machine aServer user aUserName password \"netrc-B aPassword\""
|
|
|
|
|
"machine aMachine server aServer user aUserName password \"netrc-C aPassword\""
|
|
|
|
|
"machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\""
|
|
|
|
|
"machine aDatabase user aUserName password \"netrc-E aPassword\""
|
|
|
|
|
"machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\""
|
|
|
|
|
"machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\""
|
|
|
|
|
"\n")
|
|
|
|
|
(cl-letf
|
|
|
|
|
((sql-test-login-params ' ,login-params)
|
|
|
|
|
((symbol-function 'sql-comint-test)
|
|
|
|
|
(lambda (product options &optional buf-name)
|
|
|
|
|
(with-current-buffer (get-buffer-create buf-name)
|
|
|
|
|
(insert (pp-to-string (list product options sql-user sql-password sql-server sql-database))))))
|
|
|
|
|
((symbol-function 'sql-run-test)
|
|
|
|
|
(lambda (&optional buffer)
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(sql-product-interactive 'sqltest buffer)))
|
|
|
|
|
(sql-user nil)
|
|
|
|
|
(sql-server nil)
|
|
|
|
|
(sql-database nil)
|
|
|
|
|
(sql-product-alist
|
|
|
|
|
'((ansi)
|
|
|
|
|
(sqltest
|
|
|
|
|
:name "SqlTest"
|
|
|
|
|
:sqli-login sql-test-login-params
|
|
|
|
|
:sqli-comint-func sql-comint-test)))
|
|
|
|
|
(sql-connection-alist
|
|
|
|
|
'((,(format "test-%s" id)
|
|
|
|
|
,@connection)))
|
|
|
|
|
(sql-password-wallet (list tempfile)))
|
|
|
|
|
(let* ((connection ,(format "test-%s" id))
|
|
|
|
|
(buffername (format "*SQL: ERT TEST <%s>*" connection)))
|
|
|
|
|
(when (get-buffer buffername)
|
|
|
|
|
(kill-buffer buffername))
|
|
|
|
|
(sql-connect connection buffername)
|
|
|
|
|
(should (get-buffer buffername))
|
|
|
|
|
(should (string-equal (with-current-buffer buffername (buffer-string)) ,expected))
|
|
|
|
|
(when (get-buffer buffername)
|
|
|
|
|
(kill-buffer buffername))))))
|
2019-02-18 23:15:54 -05:00
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-connect ()
|
|
|
|
|
"Test of basic `sql-connect'."
|
|
|
|
|
(with-sql-test-connect-harness 1 (user password server database)
|
2019-02-20 22:13:51 -05:00
|
|
|
|
((sql-product 'sqltest)
|
|
|
|
|
(sql-user "aUserName")
|
|
|
|
|
(sql-password "test-1 aPassword")
|
|
|
|
|
(sql-server "aServer")
|
|
|
|
|
(sql-database "aDatabase"))
|
2019-02-18 23:15:54 -05:00
|
|
|
|
"(sqltest nil \"aUserName\" \"test-1 aPassword\" \"aServer\" \"aDatabase\")\n"))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-connect-password-func ()
|
|
|
|
|
"Test of password function."
|
|
|
|
|
(with-sql-test-connect-harness 2 (user password server database)
|
2019-02-20 22:13:51 -05:00
|
|
|
|
((sql-product 'sqltest)
|
|
|
|
|
(sql-user "aUserName")
|
|
|
|
|
(sql-password (lambda () (concat [?t ?e ?s ?t ?- ?2 ?\s
|
|
|
|
|
?a ?P ?a ?s ?s ?w ?o ?r ?d])))
|
|
|
|
|
(sql-server "aServer")
|
|
|
|
|
(sql-database "aDatabase"))
|
2019-02-18 23:15:54 -05:00
|
|
|
|
"(sqltest nil \"aUserName\" \"test-2 aPassword\" \"aServer\" \"aDatabase\")\n"))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-connect-wallet-server-database ()
|
|
|
|
|
"Test of password function."
|
|
|
|
|
(with-sql-test-connect-harness 3 (user password server database)
|
2019-02-20 22:13:51 -05:00
|
|
|
|
((sql-product 'sqltest)
|
|
|
|
|
(sql-user "aUserName")
|
|
|
|
|
(sql-server "aServer")
|
|
|
|
|
(sql-database "aDatabase"))
|
2019-02-18 23:15:54 -05:00
|
|
|
|
"(sqltest nil \"aUserName\" \"netrc-G aPassword\" \"aServer\" \"aDatabase\")\n"))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-connect-wallet-database ()
|
|
|
|
|
"Test of password function."
|
|
|
|
|
(with-sql-test-connect-harness 4 (user password database)
|
2019-02-20 22:13:51 -05:00
|
|
|
|
((sql-product 'sqltest)
|
|
|
|
|
(sql-user "aUserName")
|
|
|
|
|
(sql-database "aDatabase"))
|
2019-02-18 23:15:54 -05:00
|
|
|
|
"(sqltest nil \"aUserName\" \"netrc-E aPassword\" nil \"aDatabase\")\n"))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-connect-wallet-server ()
|
|
|
|
|
"Test of password function."
|
|
|
|
|
(with-sql-test-connect-harness 5 (user password server)
|
2019-02-20 22:13:51 -05:00
|
|
|
|
((sql-product 'sqltest)
|
|
|
|
|
(sql-user "aUserName")
|
|
|
|
|
(sql-server "aServer"))
|
2019-02-18 23:15:54 -05:00
|
|
|
|
"(sqltest nil \"aUserName\" \"netrc-B aPassword\" \"aServer\" nil)\n"))
|
|
|
|
|
|
2019-02-20 22:13:51 -05:00
|
|
|
|
;;; Set/Get Product Features
|
|
|
|
|
|
|
|
|
|
(defvar sql-test-feature-value-a nil "Indirect value A.")
|
|
|
|
|
(defvar sql-test-feature-value-b nil "Indirect value B.")
|
|
|
|
|
(defvar sql-test-feature-value-c nil "Indirect value C.")
|
|
|
|
|
(defvar sql-test-feature-value-d nil "Indirect value D.")
|
|
|
|
|
(defmacro sql-test-product-feature-harness (&rest action)
|
|
|
|
|
"Set-up and tear-down of testing product/feature API.
|
|
|
|
|
|
|
|
|
|
Perform ACTION and validate results"
|
|
|
|
|
(declare (indent 2))
|
|
|
|
|
`(cl-letf
|
|
|
|
|
((sql-product-alist
|
|
|
|
|
(list (list 'a :X 1 :Y 2 :Z 'sql-test-feature-value-a)
|
|
|
|
|
(list 'b :X 3 :Z 'sql-test-feature-value-b)
|
|
|
|
|
(list 'c :Y 6 :Z 'sql-test-feature-value-c)
|
|
|
|
|
(list 'd :X 7 :Y 8 )))
|
|
|
|
|
(sql-indirect-features '(:Z :W))
|
|
|
|
|
(sql-test-feature-value-a "original A")
|
|
|
|
|
(sql-test-feature-value-b "original B")
|
|
|
|
|
(sql-test-feature-value-c "original C")
|
|
|
|
|
(sql-test-feature-value-d "original D"))
|
|
|
|
|
,@action))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-add-product ()
|
|
|
|
|
"Add a product"
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(sql-add-product 'xyz "XyzDb")
|
|
|
|
|
|
|
|
|
|
(should (equal (pp-to-string (assoc 'xyz sql-product-alist))
|
2020-03-29 20:52:10 -04:00
|
|
|
|
"(xyz :name \"XyzDb\")\n")))
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(sql-add-product 'stu "StuDb" :X 1 :Y "2")
|
|
|
|
|
|
|
|
|
|
(should (equal (pp-to-string (assoc 'stu sql-product-alist))
|
|
|
|
|
"(stu :name \"StuDb\" :X 1 :Y \"2\")\n"))))
|
2019-02-20 22:13:51 -05:00
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-add-existing-product ()
|
|
|
|
|
"Add a product that already exists."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
2020-06-02 23:14:23 +01:00
|
|
|
|
(should-error (sql-add-product 'a "Aaa"))
|
2019-02-20 22:13:51 -05:00
|
|
|
|
(should (equal (pp-to-string (assoc 'a sql-product-alist))
|
|
|
|
|
"(a :X 1 :Y 2 :Z sql-test-feature-value-a)\n"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-set-feature ()
|
|
|
|
|
"Add a feature"
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(sql-set-product-feature 'b :Y 4)
|
|
|
|
|
(should (equal (pp-to-string (assoc 'b sql-product-alist))
|
|
|
|
|
"(b :Y 4 :X 3 :Z sql-test-feature-value-b)\n"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-set-indirect-feature ()
|
|
|
|
|
"Set a new indirect feature"
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(sql-set-product-feature 'd :Z 'sql-test-feature-value-d)
|
|
|
|
|
(should (equal (pp-to-string (assoc 'd sql-product-alist))
|
|
|
|
|
"(d :Z sql-test-feature-value-d :X 7 :Y 8)\n"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-set-existing-feature ()
|
|
|
|
|
"Set an existing feature."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(sql-set-product-feature 'b :X 33)
|
|
|
|
|
(should (equal (pp-to-string (assoc 'b sql-product-alist))
|
|
|
|
|
"(b :X 33 :Z sql-test-feature-value-b)\n"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-set-existing-indirect-feature ()
|
|
|
|
|
"Set an existing indirect feature."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(should (equal sql-test-feature-value-b "original B"))
|
|
|
|
|
(sql-set-product-feature 'b :Z "Hurray!")
|
|
|
|
|
(should (equal (pp-to-string (assoc 'b sql-product-alist))
|
|
|
|
|
"(b :X 3 :Z sql-test-feature-value-b)\n")) ;; unchanged
|
|
|
|
|
(should (equal sql-test-feature-value-b "Hurray!"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-set-missing-product ()
|
|
|
|
|
"Add a feature to a missing product."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(should-error (sql-set-product-feature 'x :Y 4))
|
|
|
|
|
(should-not (assoc 'x sql-product-alist))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-get-feature ()
|
|
|
|
|
"Get a feature value."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(should (equal (sql-get-product-feature 'c :Y) 6))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-get-indirect-feature ()
|
|
|
|
|
"Get a feature indirect value."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(should (equal (sql-get-product-feature 'c :Z nil t) 'sql-test-feature-value-c))
|
|
|
|
|
(should (equal sql-test-feature-value-c "original C"))
|
|
|
|
|
(should (equal (sql-get-product-feature 'c :Z) "original C"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-get-missing-product ()
|
|
|
|
|
"Get a feature value from a missing product."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(should-error (sql-get-product-feature 'x :Y))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-get-missing-feature ()
|
|
|
|
|
"Get a missing feature value."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(should-not (sql-get-product-feature 'c :X))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-test-get-missing-indirect-feature ()
|
|
|
|
|
"Get a missing indirect feature value."
|
|
|
|
|
|
|
|
|
|
(sql-test-product-feature-harness
|
|
|
|
|
(should-not (sql-get-product-feature 'd :Z))))
|
|
|
|
|
|
2019-04-20 20:13:56 -04:00
|
|
|
|
;;; SQL Oracle SCAN/DEFINE
|
2019-04-24 20:59:25 -04:00
|
|
|
|
(defmacro sql-tests-placeholder-filter-harness (orig repl outp)
|
|
|
|
|
"Set-up and tear-down of testing of placeholder filter.
|
|
|
|
|
|
|
|
|
|
The placeholder in ORIG will be replaced by REPL which should
|
|
|
|
|
yield OUTP."
|
|
|
|
|
|
|
|
|
|
(declare (indent 0))
|
|
|
|
|
`(let ((syntab (syntax-table))
|
|
|
|
|
(sql-oracle-scan-on t))
|
|
|
|
|
(set-syntax-table sql-mode-syntax-table)
|
|
|
|
|
|
|
|
|
|
(cl-letf
|
|
|
|
|
(((symbol-function 'read-from-minibuffer)
|
|
|
|
|
(lambda (&rest _) ,repl)))
|
|
|
|
|
|
|
|
|
|
(should (equal (sql-placeholders-filter ,orig) ,outp)))
|
|
|
|
|
|
|
|
|
|
(set-syntax-table syntab)))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-placeholder-filter-simple ()
|
|
|
|
|
"Test that placeholder relacement of simple replacement text."
|
|
|
|
|
(sql-tests-placeholder-filter-harness
|
|
|
|
|
"select '&x' from dual;" "XX"
|
|
|
|
|
"select 'XX' from dual;"))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-placeholder-filter-ampersand ()
|
|
|
|
|
"Test that placeholder relacement of replacement text with ampersand."
|
|
|
|
|
(sql-tests-placeholder-filter-harness
|
|
|
|
|
"select '&x' from dual;" "&Y"
|
|
|
|
|
"select '&Y' from dual;")
|
|
|
|
|
|
|
|
|
|
(sql-tests-placeholder-filter-harness
|
|
|
|
|
"select '&x' from dual;" "Y&"
|
|
|
|
|
"select 'Y&' from dual;")
|
|
|
|
|
|
|
|
|
|
(sql-tests-placeholder-filter-harness
|
|
|
|
|
"select '&x' from dual;" "Y&Y"
|
|
|
|
|
"select 'Y&Y' from dual;"))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-placeholder-filter-period ()
|
|
|
|
|
"Test that placeholder relacement of token terminated by a period."
|
|
|
|
|
(sql-tests-placeholder-filter-harness
|
|
|
|
|
"select '&x.' from dual;" "&Y"
|
|
|
|
|
"select '&Y' from dual;")
|
|
|
|
|
|
|
|
|
|
(sql-tests-placeholder-filter-harness
|
|
|
|
|
"select '&x.y' from dual;" "&Y"
|
|
|
|
|
"select '&Yy' from dual;")
|
|
|
|
|
|
|
|
|
|
(sql-tests-placeholder-filter-harness
|
|
|
|
|
"select '&x..y' from dual;" "&Y"
|
|
|
|
|
"select '&Y.y' from dual;"))
|
|
|
|
|
|
|
|
|
|
;; Buffer naming
|
|
|
|
|
(defmacro sql-tests-buffer-naming-harness (product &rest action)
|
|
|
|
|
"Set-up and tear-down of test of buffer naming.
|
|
|
|
|
|
|
|
|
|
The ACTION will be tested after set-up of PRODUCT."
|
|
|
|
|
|
|
|
|
|
(declare (indent 1))
|
2019-04-25 19:53:02 -04:00
|
|
|
|
`(progn
|
2019-04-25 22:06:34 -04:00
|
|
|
|
(ert--skip-unless (executable-find sql-sqlite-program))
|
2019-04-25 19:53:02 -04:00
|
|
|
|
(let (new-bufs)
|
|
|
|
|
(cl-letf
|
|
|
|
|
(((symbol-function 'make-comint-in-buffer)
|
|
|
|
|
(lambda (_name buffer _program &optional _startfile &rest _switches)
|
|
|
|
|
(let ((b (get-buffer-create buffer)))
|
|
|
|
|
(message ">>make-comint-in-buffer %S" b)
|
|
|
|
|
(cl-pushnew b new-bufs) ;; Keep track of what we create
|
|
|
|
|
b))))
|
|
|
|
|
|
|
|
|
|
(let (,(intern (format "sql-%s-login-params" product)))
|
|
|
|
|
,@action)
|
|
|
|
|
|
|
|
|
|
(let (kill-buffer-query-functions) ;; Kill what we create
|
|
|
|
|
(mapc #'kill-buffer new-bufs))))))
|
2019-04-24 20:59:25 -04:00
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-buffer-naming-default ()
|
|
|
|
|
"Test buffer naming."
|
|
|
|
|
(sql-tests-buffer-naming-harness sqlite
|
|
|
|
|
(sql-sqlite)
|
|
|
|
|
(message ">> %S" (current-buffer))
|
|
|
|
|
(should (equal (buffer-name) "*SQL: SQLite*"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-buffer-naming-multiple ()
|
|
|
|
|
"Test buffer naming of multiple buffers."
|
|
|
|
|
(sql-tests-buffer-naming-harness sqlite
|
|
|
|
|
(sql-sqlite)
|
|
|
|
|
(should (equal (buffer-name) "*SQL: SQLite*"))
|
|
|
|
|
|
|
|
|
|
(switch-to-buffer "*scratch*")
|
|
|
|
|
|
|
|
|
|
(sql-sqlite)
|
|
|
|
|
(should (equal (buffer-name) "*SQL: SQLite*"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-buffer-naming-explicit ()
|
|
|
|
|
"Test buffer naming with explicit name."
|
|
|
|
|
(sql-tests-buffer-naming-harness sqlite
|
|
|
|
|
(sql-sqlite "A")
|
|
|
|
|
(should (equal (buffer-name) "*SQL: A*"))
|
|
|
|
|
|
|
|
|
|
(switch-to-buffer "*scratch*")
|
|
|
|
|
|
|
|
|
|
(sql-sqlite "A")
|
|
|
|
|
(should (equal (buffer-name) "*SQL: A*"))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-buffer-naming-universal-argument ()
|
|
|
|
|
"Test buffer naming with explicit name."
|
|
|
|
|
(sql-tests-buffer-naming-harness sqlite
|
|
|
|
|
(cl-letf
|
|
|
|
|
(((symbol-function 'read-string)
|
|
|
|
|
(lambda (_prompt &optional _initial-input _history _default-value _inherit-input-method)
|
|
|
|
|
"1")))
|
|
|
|
|
(sql-sqlite '(4))
|
|
|
|
|
(should (equal (buffer-name) "*SQL: 1*")))
|
|
|
|
|
|
|
|
|
|
(switch-to-buffer "*scratch*")
|
|
|
|
|
|
|
|
|
|
(cl-letf
|
|
|
|
|
(((symbol-function 'read-string)
|
|
|
|
|
(lambda (_prompt &optional _initial-input _history _default-value _inherit-input-method)
|
|
|
|
|
"2")))
|
|
|
|
|
(sql-sqlite '(16))
|
|
|
|
|
(should (equal (buffer-name) "*SQL: 2*")))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-buffer-naming-existing ()
|
|
|
|
|
"Test buffer naming with an existing non-SQLi buffer."
|
|
|
|
|
(sql-tests-buffer-naming-harness sqlite
|
|
|
|
|
(get-buffer-create "*SQL: exist*")
|
|
|
|
|
|
|
|
|
|
(cl-letf
|
|
|
|
|
(((symbol-function 'read-string)
|
|
|
|
|
(lambda (_prompt &optional _initial-input _history _default-value _inherit-input-method)
|
|
|
|
|
"exist")))
|
|
|
|
|
(sql-sqlite '(4))
|
|
|
|
|
(should (equal (buffer-name) "*SQL: exist-1*")))
|
|
|
|
|
|
|
|
|
|
(kill-buffer "*SQL: exist*")))
|
2019-04-20 20:13:56 -04:00
|
|
|
|
|
2021-10-19 00:18:17 -04:00
|
|
|
|
(ert-deftest sql-tests-comint-automatic-password ()
|
|
|
|
|
(let ((sql-password nil))
|
|
|
|
|
(should-not (sql-comint-automatic-password "Password: ")))
|
|
|
|
|
(let ((sql-password ""))
|
|
|
|
|
(should-not (sql-comint-automatic-password "Password: ")))
|
|
|
|
|
(let ((sql-password "password"))
|
|
|
|
|
(should (equal "password" (sql-comint-automatic-password "Password: "))))
|
|
|
|
|
;; Also, we shouldn't care what the password is - we rely on comint for that.
|
|
|
|
|
(let ((sql-password "password"))
|
|
|
|
|
(should (equal "password" (sql-comint-automatic-password "")))))
|
2019-04-20 20:13:56 -04:00
|
|
|
|
|
2022-05-03 12:35:34 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Tests for sql-interactive-remove-continuation-prompt
|
|
|
|
|
|
|
|
|
|
(defmacro sql-tests-remove-cont-prompts-harness (&rest body)
|
|
|
|
|
"Set-up and tear-down for tests of
|
|
|
|
|
`sql-interactive-remove-continuation-prompt'."
|
|
|
|
|
(declare (indent 0))
|
|
|
|
|
`(let ((comint-prompt-regexp "^ +\\.\\{3\\} ")
|
|
|
|
|
(sql-output-newline-count nil)
|
|
|
|
|
(sql-preoutput-hold nil))
|
|
|
|
|
,@body
|
|
|
|
|
(should (null sql-output-newline-count))
|
|
|
|
|
(should (null sql-preoutput-hold))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-remove-cont-prompts-pass-through ()
|
|
|
|
|
"Test that `sql-interactive-remove-continuation-prompt' just
|
|
|
|
|
passes the output line through when it doesn't expect prompts."
|
|
|
|
|
(sql-tests-remove-cont-prompts-harness
|
|
|
|
|
(should
|
|
|
|
|
(equal " ... "
|
|
|
|
|
(sql-interactive-remove-continuation-prompt
|
|
|
|
|
" ... ")))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-remove-cont-prompts-anchored-successive ()
|
|
|
|
|
"Test that `sql-interactive-remove-continuation-prompt' is able
|
|
|
|
|
to delete multiple prompts (anchored to bol) even if they appear
|
|
|
|
|
in a single line, but not more than `sql-output-newline-count'."
|
|
|
|
|
(sql-tests-remove-cont-prompts-harness
|
|
|
|
|
(setq sql-output-newline-count 2)
|
|
|
|
|
(should
|
|
|
|
|
(equal
|
|
|
|
|
;; 2 of 3 prompts are deleted
|
|
|
|
|
"some output ... more output...\n\
|
|
|
|
|
... \n\
|
|
|
|
|
output after prompt"
|
|
|
|
|
(sql-interactive-remove-continuation-prompt
|
|
|
|
|
"some output ... more output...\n\
|
|
|
|
|
... ... ... \n\
|
|
|
|
|
output after prompt")))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-remove-cont-prompts-collect-chunked-output ()
|
|
|
|
|
"Test that `sql-interactive-remove-continuation-prompt' properly
|
|
|
|
|
collects output when output arrives in chunks, with prompts
|
|
|
|
|
intermixed."
|
|
|
|
|
(sql-tests-remove-cont-prompts-harness
|
|
|
|
|
(setq sql-output-newline-count 2)
|
|
|
|
|
|
|
|
|
|
;; Part of first prompt gets held. Complete line is passed
|
|
|
|
|
;; through.
|
|
|
|
|
(should (equal "line1\n"
|
|
|
|
|
(sql-interactive-remove-continuation-prompt
|
|
|
|
|
"line1\n ..")))
|
|
|
|
|
(should (equal " .." sql-preoutput-hold))
|
|
|
|
|
(should (equal 2 sql-output-newline-count))
|
|
|
|
|
|
|
|
|
|
;; First prompt is complete - remove it. Hold part of line2.
|
|
|
|
|
(should (equal ""
|
|
|
|
|
(sql-interactive-remove-continuation-prompt ". li")))
|
|
|
|
|
(should (equal "li" sql-preoutput-hold))
|
|
|
|
|
(should (equal 1 sql-output-newline-count))
|
|
|
|
|
|
|
|
|
|
;; Remove second prompt. Flush output & don't hold / process any
|
|
|
|
|
;; output further on.
|
|
|
|
|
(should (equal "line2\nli"
|
|
|
|
|
(sql-interactive-remove-continuation-prompt "ne2\n ... li")))
|
|
|
|
|
(should (null sql-preoutput-hold))
|
|
|
|
|
(should (null sql-output-newline-count))
|
|
|
|
|
(should (equal "line3\n ... "
|
|
|
|
|
(sql-interactive-remove-continuation-prompt "line3\n ... ")))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest sql-tests-remove-cont-prompts-flush-held ()
|
|
|
|
|
"Test that when we don't wait for prompts,
|
|
|
|
|
`sql-interactive-remove-continuation-prompt' just 'flushes' held
|
|
|
|
|
output, with no prompt processing."
|
|
|
|
|
(sql-tests-remove-cont-prompts-harness
|
|
|
|
|
(setq sql-preoutput-hold "line1\n ..")
|
|
|
|
|
(should (equal "line1\n ... line2 .."
|
|
|
|
|
(sql-interactive-remove-continuation-prompt ". line2 ..")))))
|
|
|
|
|
|
2016-11-15 19:08:22 +01:00
|
|
|
|
(provide 'sql-tests)
|
|
|
|
|
;;; sql-tests.el ends here
|