;;; minibuffer-tests.el --- Tests for completion functions -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2021 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; 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 ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; ;;; Code: (require 'ert) (require 'ert-x) (eval-when-compile (require 'cl-lib)) (ert-deftest completion-test1 () (with-temp-buffer (cl-flet* ((test/completion-table (_string _pred action) (if (eq action 'lambda) nil "test: ")) (test/completion-at-point () (list (copy-marker (point-min)) (copy-marker (point)) #'test/completion-table))) (let ((completion-at-point-functions (list #'test/completion-at-point))) (insert "TEST") (completion-at-point) (should (equal (buffer-string) "test: ")))))) (ert-deftest completion-table-with-predicate-test () (let ((full-collection '("apple" ; Has A. "beet" ; Has B. "banana" ; Has A & B. "cherry" ; Has neither. )) (no-A (lambda (x) (not (string-match-p "a" x)))) (no-B (lambda (x) (not (string-match-p "b" x))))) (should (member "cherry" (completion-table-with-predicate full-collection no-A t "" no-B t))) (should-not (member "banana" (completion-table-with-predicate full-collection no-A t "" no-B t))) ;; "apple" should still match when strict is nil. (should (eq t (try-completion "apple" (apply-partially 'completion-table-with-predicate full-collection no-A nil) no-B))) ;; "apple" should still match when strict is nil and pred2 is nil ;; (Bug#27841). (should (eq t (try-completion "apple" (apply-partially 'completion-table-with-predicate full-collection no-A nil)))))) (ert-deftest completion-table-subvert-test () (let* ((origtable '("A-hello" "A-there")) (subvtable (completion-table-subvert origtable "B" "A"))) (should (equal (try-completion "B-hel" subvtable) "B-hello")) (should (equal (all-completions "B-hel" subvtable) '("-hello"))) (should (test-completion "B-hello" subvtable)) (should (equal (completion-boundaries "B-hel" subvtable nil "suffix") '(1 . 6))))) (ert-deftest completion-table-test-quoting () (let ((process-environment `("CTTQ1=ed" "CTTQ2=et/" ,@process-environment)) (default-directory (ert-resource-directory))) (pcase-dolist (`(,input ,output) '( ;; Test that $ in files is properly $$ quoted. ("data/m-cttq" "data/minibuffer-test-cttq$$tion") ;; Test that $$ in input is properly unquoted. ("data/m-cttq$$t" "data/minibuffer-test-cttq$$tion") ;; Test that env-vars are preserved. ("lisp/c${CTTQ1}et/se-u" "lisp/c${CTTQ1}et/semantic-utest") ("lisp/ced${CTTQ2}se-u" "lisp/ced${CTTQ2}semantic-utest") ;; Test that env-vars don't prevent partial-completion. ;; FIXME: Ideally we'd like to keep the ${CTTQ}! ("lis/c${CTTQ1}/se-u" "lisp/cedet/semantic-utest") )) (should (equal (completion-try-completion input #'completion--file-name-table nil (length input)) (cons output (length output))))))) (ert-deftest completion--insert-strings-faces () (with-temp-buffer (completion--insert-strings '(("completion1" "suffix1"))) (should (equal (get-text-property 12 'face) '(completions-annotations)))) (with-temp-buffer (completion--insert-strings '(("completion1" #("suffix1" 0 7 (face shadow))))) (should (equal (get-text-property 12 'face) 'shadow))) (with-temp-buffer (completion--insert-strings '(("completion1" "prefix1" "suffix1"))) (should (equal (get-text-property 19 'face) nil))) (with-temp-buffer (completion--insert-strings '(("completion1" "prefix1" #("suffix1" 0 7 (face shadow))))) (should (equal (get-text-property 19 'face) 'shadow)))) (ert-deftest completion-pcm--optimize-pattern () (should (equal (completion-pcm--optimize-pattern '("buf" point "f")) '("buf" point "f"))) (should (equal (completion-pcm--optimize-pattern '(any "" any)) '(any)))) (defun test-completion-all-sorted-completions (base def history-var history-list) (with-temp-buffer (insert base) (cl-letf (((symbol-function #'minibufferp) (lambda (&rest _) t))) (let ((completion-styles '(basic)) (completion-category-defaults nil) (completion-category-overrides nil) (minibuffer-history-variable history-var) (minibuffer-history history-list) (minibuffer-default def) (minibuffer-completion-table (lambda (str pred action) (pcase action (`(boundaries . ,_) `(boundaries ,(length base) . 0)) (_ (complete-with-action action '(epsilon alpha gamma beta delta) (substring str (length base)) pred)))))) (completion-all-sorted-completions))))) (ert-deftest completion-all-sorted-completions () ;; No base, disabled history, no default (should (equal (test-completion-all-sorted-completions "" nil t nil) `("beta" "alpha" "delta" "gamma" "epsilon" . 0))) ;; No base, disabled history, default string (should (equal (test-completion-all-sorted-completions "" "gamma" t nil) `("gamma" "beta" "alpha" "delta" "epsilon" . 0))) ;; No base, empty history, default string (should (equal (test-completion-all-sorted-completions "" "gamma" 'minibuffer-history nil) `("gamma" "beta" "alpha" "delta" "epsilon" . 0))) ;; No base, empty history, default list (should (equal (test-completion-all-sorted-completions "" '("gamma" "zeta") 'minibuffer-history nil) `("gamma" "beta" "alpha" "delta" "epsilon" . 0))) ;; No base, history, default string (should (equal (test-completion-all-sorted-completions "" "gamma" 'minibuffer-history '("other" "epsilon" "delta")) `("gamma" "epsilon" "delta" "beta" "alpha" . 0))) ;; Base, history, default string (should (equal (test-completion-all-sorted-completions "base/" "gamma" 'minibuffer-history '("some/alpha" "base/epsilon" "base/delta")) `("gamma" "epsilon" "delta" "beta" "alpha" . 5)))) (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here