Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs into feature/pgtk

1 files changed, 55 insertions, 47 deletions

diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el
index 21dd0649529..1bbe3a95e90 100644
--- a/test/lisp/progmodes/sql-tests.el
+++ b/test/lisp/progmodes/sql-tests.el
@@ -28,6 +28,7 @@
 
 (require 'cl-lib)
 (require 'ert)
+(require 'ert-x)
 (require 'sql)
 
 (ert-deftest sql-tests-postgres-list-databases ()
@@ -50,7 +51,7 @@
         (lambda (_command) t))
        ((symbol-function 'process-lines)
         (lambda (_program &rest _args)
-          (error "some error"))))
+          (error "Some error"))))
     (should-not (sql-postgres-list-databases))))
 
 ;;; Check Connection Password Handling/Wallet
@@ -63,52 +64,49 @@ 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))
-  `(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
-          (make-temp-file
-           "sql-test-netrc" nil nil
-           (mapconcat #'identity
-                      '("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")))))
-
-     (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))
-       (delete-file (car sql-password-wallet)))))
+  `(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'."
@@ -416,6 +414,16 @@ The ACTION will be tested after set-up of PRODUCT."
 
     (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 "")))))
 
 (provide 'sql-tests)
 ;;; sql-tests.el ends here