diff options
Diffstat (limited to 'test/lisp/progmodes/sql-tests.el')
| -rw-r--r-- | test/lisp/progmodes/sql-tests.el | 456 |
1 files changed, 454 insertions, 2 deletions
diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index ad22906ecf1..c644d115df6 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -1,6 +1,6 @@ ;;; sql-tests.el --- Tests for sql.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2022 Free Software Foundation, Inc. ;; Author: Simen Heggestøyl <simenheg@gmail.com> ;; Keywords: @@ -28,6 +28,7 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'sql) (ert-deftest sql-tests-postgres-list-databases () @@ -50,8 +51,459 @@ (lambda (_command) t)) ((symbol-function 'process-lines) (lambda (_program &rest _args) - (error)))) + (error "Some error")))) (should-not (sql-postgres-list-databases)))) +;;; Check Connection Password Handling/Wallet + +(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)) + `(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)))))) + +(ert-deftest sql-test-connect () + "Test of basic `sql-connect'." + (with-sql-test-connect-harness 1 (user password server database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-password "test-1 aPassword") + (sql-server "aServer") + (sql-database "aDatabase")) + "(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) + ((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")) + "(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) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-server "aServer") + (sql-database "aDatabase")) + "(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) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-database "aDatabase")) + "(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) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-server "aServer")) + "(sqltest nil \"aUserName\" \"netrc-B aPassword\" \"aServer\" nil)\n")) + +;;; 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)) + "(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")))) + +(ert-deftest sql-test-add-existing-product () + "Add a product that already exists." + + (sql-test-product-feature-harness + (should-error (sql-add-product 'a "Aaa")) + (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)))) + +;;; SQL Oracle SCAN/DEFINE +(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)) + `(progn + (ert--skip-unless (executable-find sql-sqlite-program)) + (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)))))) + +(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*"))) + +(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 ""))))) + + + +;; 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 .."))))) + (provide 'sql-tests) ;;; sql-tests.el ends here |