diff options
author | Michael R. Mauger <michael@mauger.com> | 2019-04-24 20:59:25 -0400 |
---|---|---|
committer | Michael R. Mauger <michael@mauger.com> | 2019-04-24 20:59:25 -0400 |
commit | a1386fa6a7698c04902354cd5fefb39056b0a901 (patch) | |
tree | 9d4ee7ae5b4d3cc13e0b88a445ec2e1c35e36117 /test | |
parent | 2bf957394cdcb93396966d3289f5e200886cb424 (diff) | |
download | emacs-a1386fa6a7698c04902354cd5fefb39056b0a901.tar.gz |
* lisp/progmodes/sql.el
(sql-is-sqli-buffer-p): New function.
(sql-generate-unique-sqli-buffer-name): Refactor and use it.
(sql-product-interactive): Simplify name logic.
* test/lisp/progmodes/sql-tests.el
(sql-tests-placeholder-filter-harness): New macro.
(sql-tests-placeholder-filter-simple)
(sql-tests-placeholder-filter-ampersand)
(sql-tests-placeholder-filter-period): Refactored tests and use macro.
(sql-tests-buffer-naming-harness): New macro.
(sql-tests-buffer-naming-default)
(sql-tests-buffer-naming-multiple)
(sql-tests-buffer-naming-explicit)
(sql-tests-buffer-naming-universal-argument)
(sql-tests-buffer-naming-existing): New tests.
Diffstat (limited to 'test')
-rw-r--r-- | test/lisp/progmodes/sql-tests.el | 167 |
1 files changed, 136 insertions, 31 deletions
diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 5ac34907c2d..ad1f7976526 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -271,37 +271,142 @@ Perform ACTION and validate results" (should-not (sql-get-product-feature 'd :Z)))) ;;; SQL Oracle SCAN/DEFINE -(ert-deftest sql-tests-placeholder-filter () - "Test that placeholder relacement is as expected." - (let ((syntab (syntax-table)) - (sql-oracle-scan-on t) - (placeholder-value "")) - (set-syntax-table sql-mode-syntax-table) - - (cl-letf - (((symbol-function 'read-from-minibuffer) - (lambda (&rest _) placeholder-value))) - - (setq placeholder-value "XX") - (should (equal - (sql-placeholders-filter "select '&x' from dual;") - "select 'XX' from dual;")) - - (setq placeholder-value "&Y") - (should (equal - (sql-placeholders-filter "select '&x' from dual;") - "select '&Y' from dual;")) - (should (equal - (sql-placeholders-filter "select '&x' from dual;") - "select '&Y' from dual;")) - (should (equal - (sql-placeholders-filter "select '&x.' from dual;") - "select '&Y' from dual;")) - (should (equal - (sql-placeholders-filter "select '&x.y' from dual;") - "select '&Yy' from dual;"))) - - (set-syntax-table syntab))) +(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)) + `(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*"))) (provide 'sql-tests) |