mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/progmodes/sql.el

Browse source 
(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.
This commit is contained in:
Michael R. Mauger 2019-04-24 20:59:25 -04:00
parent 2bf957394c
commit a1386fa6a7
2 changed files with 162 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

159
test/lisp/progmodes/sql-tests.el
View file

@ -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)
(defmacro sql-tests-placeholder-filter-harness (orig repl outp)
"Set-up and tear-down of testing of placeholder filter.
(cl-letf
(((symbol-function 'read-from-minibuffer)
(lambda (&rest _) placeholder-value)))
The placeholder in ORIG will be replaced by REPL which should
yield OUTP."
(setq placeholder-value "XX")
(should (equal
(sql-placeholders-filter "select '&x' from dual;")
"select 'XX' from dual;"))
(declare (indent 0))
`(let ((syntab (syntax-table))
(sql-oracle-scan-on t))
(set-syntax-table sql-mode-syntax-table)
(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;")))
(cl-letf
(((symbol-function 'read-from-minibuffer)
(lambda (&rest _) ,repl)))
(set-syntax-table syntab)))
(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)