From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#24966: 26.0.50; test-completion with alist COLLECTION calls PREDICATE incorrectly Date: Sun, 27 Nov 2016 15:24:27 -0500 Message-ID: <87eg1wisck.fsf_-_@users.sourceforge.net> References: <87shqnpxym.fsf@udel.edu> <87fumljw98.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1480278262 5431 195.159.176.226 (27 Nov 2016 20:24:22 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 27 Nov 2016 20:24:22 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.1 (gnu/linux) Cc: 24966@debbugs.gnu.org To: Mark Oteiza Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Nov 27 21:24:16 2016 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cB5zi-000061-WF for geb-bug-gnu-emacs@m.gmane.org; Sun, 27 Nov 2016 21:24:15 +0100 Original-Received: from localhost ([::1]:55496 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cB5zl-0007Pe-5X for geb-bug-gnu-emacs@m.gmane.org; Sun, 27 Nov 2016 15:24:17 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:35275) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cB5zZ-0007OA-NR for bug-gnu-emacs@gnu.org; Sun, 27 Nov 2016 15:24:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cB5zW-0001vl-Ew for bug-gnu-emacs@gnu.org; Sun, 27 Nov 2016 15:24:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:56713) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cB5zW-0001vf-9O for bug-gnu-emacs@gnu.org; Sun, 27 Nov 2016 15:24:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cB5zW-0000xO-3L for bug-gnu-emacs@gnu.org; Sun, 27 Nov 2016 15:24:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 27 Nov 2016 20:24:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 24966 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: confirmed Original-Received: via spool by 24966-submit@debbugs.gnu.org id=B24966.14802782213645 (code B ref 24966); Sun, 27 Nov 2016 20:24:02 +0000 Original-Received: (at 24966) by debbugs.gnu.org; 27 Nov 2016 20:23:41 +0000 Original-Received: from localhost ([127.0.0.1]:43879 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cB5zA-0000wd-8N for submit@debbugs.gnu.org; Sun, 27 Nov 2016 15:23:41 -0500 Original-Received: from mail-io0-f169.google.com ([209.85.223.169]:33743) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cB5z7-0000wL-Fb; Sun, 27 Nov 2016 15:23:38 -0500 Original-Received: by mail-io0-f169.google.com with SMTP id j65so199344553iof.0; Sun, 27 Nov 2016 12:23:37 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=GIdTVKNcCq62f/tZqVeIKn0yrCYRIuffseWW11Bz3G0=; b=jYHlyHTz1yoV9fDhHtjBILeWv4PS7/NrPqN2M+Bc/yFevjKARacvikfBuuHeh+0Mav WYJWDQPLoCgSe7UeBFj9QzxKOiRcdYh/aYJr1vPk9CZhtjaLlYHK8CCShREXUf5G5VYQ wwreWJ1uJKkfTPGDkXh0fnNea/UIZoN57q4RWuCxd645Mgs8w0EwTkkxmx4quRrOJnsX XC5YZe5UzePKp0cHirBa1PIuY1n5hkXRLsrWJw/3eYoA4ybd26i2IyrOdTIQWPsmYLJe eSwLrqxm8tcCdb4yglBIxvE01+plYonnGHzl1KrRkQ0kkkRBZuC8TcRxYt0YoR/l0oBW iovA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=GIdTVKNcCq62f/tZqVeIKn0yrCYRIuffseWW11Bz3G0=; b=TxjV02qozxl2hOYUN/3OddCJyM6sMJ6k8rtWkX4oXrwNZKZhljUoGQSNZBLsXbwMSJ E9l4fGsiEGicfW5ffKTnOyfZA6/k2KjazZ5Zg0jOuJ3Bg0oQDcNzfavMvuij7C6hW+/K heIEnCv3pvyC73iH6o6GcZVV3eMzuFxQqviMbcdTcsDQIAHNPCNyMJMHDRpig/Bm7wgN DLevaKszSPuk7reaZDln4317ofptxEBAJCG3Bx5QuexFrVBC18nLlDpUeU3AgVLV4hx6 zrez2/N42WTyzdw8CdlHRivzeiEzXR2fdJxC6DaGNABcyyfsQo/sL1HyBQipjH6Sv5LJ Sv4A== X-Gm-Message-State: AKaTC01vt2Afwj2WAUerOQEq/MvBd8LVWmpBIK8yb4Y5leEbSFEKJeaeAeF8oy+RuNTS0g== X-Received: by 10.107.156.75 with SMTP id f72mr16151813ioe.9.1480278212003; Sun, 27 Nov 2016 12:23:32 -0800 (PST) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id w192sm8057785itw.3.2016.11.27.12.23.31 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 27 Nov 2016 12:23:31 -0800 (PST) In-Reply-To: <87fumljw98.fsf@users.sourceforge.net> (npostavs@users.sourceforge.net's message of "Sun, 20 Nov 2016 23:24:19 -0500") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:126190 Archived-At: --=-=-= Content-Type: text/plain tags 24966 patch quit npostavs@users.sourceforge.net writes: > > I tentatively suggest the patch below, but I want to add some tests > before commiting anything. While adding tests, I found another inconsistency: when given a hashtable with symbol keys, test-completion passes the symbol-name to PREDICATE, while all-completions and try-completion pass the original symbol key. Here are two patches, the first for this bug, and the second for the other inconsistency. --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v1-0001-Give-test-completion-s-PREDICATE-full-alist-entry.patch Content-Description: patch >From ba3f1477e66536fd759c4f7128bfbca009532b14 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 27 Nov 2016 10:04:48 -0500 Subject: [PATCH v1 1/2] Give test-completion's PREDICATE full alist entry Since 2016-06-26 "Fix test-completion with completion-regexp-list", when calling test-completion with an alist collection, the predicate was recieving the string value instead of the alist entry (Bug#24966). * src/minibuf.c (Ftest_completion): Don't modify the found element, just test STRING against `completion-regexp-list'. * test/src/minibuf-tests.el: New tests for `try-completion', `all-completions', and `test-completion'. --- src/minibuf.c | 8 +- test/src/minibuf-tests.el | 406 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 409 insertions(+), 5 deletions(-) create mode 100644 test/src/minibuf-tests.el diff --git a/src/minibuf.c b/src/minibuf.c index 57eea05..6c694cb 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1686,8 +1686,6 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0, tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil); if (NILP (tem)) return Qnil; - else if (CONSP (tem)) - tem = XCAR (tem); } else if (VECTORP (collection)) { @@ -1770,9 +1768,9 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0, for (regexps = Vcompletion_regexp_list; CONSP (regexps); regexps = XCDR (regexps)) { - if (NILP (Fstring_match (XCAR (regexps), - SYMBOLP (tem) ? string : tem, - Qnil))) + /* We can test against STRING, because if we got here, then + the element is equivalent to it. */ + if (NILP (Fstring_match (XCAR (regexps), string, Qnil))) return unbind_to (count, Qnil); } unbind_to (count, Qnil); diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el new file mode 100644 index 0000000..98b8614 --- /dev/null +++ b/test/src/minibuf-tests.el @@ -0,0 +1,406 @@ +;;; minibuf-tests.el --- tests for minibuf.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; 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 . + +;;; Code: + +(require 'ert) + + +;;; Support functions for `try-completion', `all-completion', and +;;; `test-completion' tests. + +(defun minibuf-tests--strings-to-symbol-list (list) + (mapcar #'intern list)) +(defun minibuf-tests--strings-to-symbol-alist (list) + (let ((num 0)) + (mapcar (lambda (str) (cons (intern str) (cl-incf num))) list))) +(defun minibuf-tests--strings-to-string-alist (list) + (let ((num 0)) + (mapcar (lambda (str) (cons str (cl-incf num))) list))) +(defun minibuf-tests--strings-to-obarray (list) + (let ((ob (make-vector 7 0))) + (mapc (lambda (str) (intern str ob)) list) + ob)) +(defun minibuf-tests--strings-to-string-hashtable (list) + (let ((ht (make-hash-table :test #'equal)) + (num 0)) + (mapc (lambda (str) (puthash str (cl-incf num) ht)) list) + ht)) +(defun minibuf-tests--strings-to-symbol-hashtable (list) + (let ((ht (make-hash-table :test #'equal)) + (num 0)) + (mapc (lambda (str) (puthash (intern str) (cl-incf num) ht)) list) + ht)) + +;;; Functions that produce a predicate (for *-completion functions) +;;; which always returns non-nil for a given collection. + +(defun minibuf-tests--memq-of-collection (collection) + (lambda (elt) (memq elt collection))) +(defun minibuf-tests--part-of-obarray (ob) + (lambda (sym) (eq (intern-soft (symbol-name sym) ob) sym))) +(defun minibuf-tests--part-of-hashtable (table) + (lambda (k v) (equal (gethash k table) v))) + + +;;; Testing functions that are agnostic to type of COLLECTION. + +(defun minibuf-tests--try-completion (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (equal (try-completion "a" abcdef) "abc")) + (should (equal (try-completion "a" +abba) "ab")) + (should (equal (try-completion "abc" +abba) t)) + (should (equal (try-completion "abcd" +abba) nil)))) + +(defun minibuf-tests--try-completion-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (equal (try-completion "a" abcdef abcdef-member) "abc")) + (should (equal (try-completion "a" +abba +abba-member) "ab")) + (should (equal (try-completion "abc" +abba +abba-member) t)) + (should (equal (try-completion "abcd" +abba +abba-member) nil)) + (should-not (try-completion "a" abcdef #'ignore)) + (should-not (try-completion "a" +abba #'ignore)) + (should-not (try-completion "abc" +abba #'ignore)) + (should-not (try-completion "abcd" +abba #'ignore)))) + +(defun minibuf-tests--try-completion-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (equal (try-completion "a" abcdef) "abc")) + (should (equal (try-completion "a" +abba) "ab")) + (should (equal (try-completion "abc" +abba) t)) + (should (equal (try-completion "abcd" +abba) nil))) + (let ((completion-regexp-list '("X"))) + (should-not (try-completion "a" abcdef)) + (should-not (try-completion "a" +abba)) + (should-not (try-completion "abc" +abba)) + (should-not (try-completion "abcd" +abba))))) + +(defun minibuf-tests--all-completions (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (equal (all-completions "a" abcdef) '("abc"))) + (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba) '("abc"))) + (should (equal (all-completions "abcd" +abba) nil)))) + +(defun minibuf-tests--all-completions-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) + (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) + (should (equal (all-completions "abcd" +abba +abba-member) nil)) + (should-not (all-completions "a" abcdef #'ignore)) + (should-not (all-completions "a" +abba #'ignore)) + (should-not (all-completions "abc" +abba #'ignore)) + (should-not (all-completions "abcd" +abba #'ignore)))) + +(defun minibuf-tests--all-completions-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (equal (all-completions "a" abcdef) '("abc"))) + (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba) '("abc"))) + (should (equal (all-completions "abcd" +abba) nil))) + (let ((completion-regexp-list '("X"))) + (should-not (all-completions "a" abcdef)) + (should-not (all-completions "a" +abba)) + (should-not (all-completions "abc" +abba)) + (should-not (all-completions "abcd" +abba))))) + +(defun minibuf-tests--test-completion (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (test-completion "abc" abcdef)) + (should (test-completion "def" +abba)) + (should (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba)))) + +(defun minibuf-tests--test-completion-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (test-completion "abc" abcdef abcdef-member)) + (should (test-completion "def" +abba +abba-member)) + (should (test-completion "abba" +abba +abba-member)) + (should-not (test-completion "abcd" +abba +abba-member)) + (should-not (test-completion "abc" abcdef #'ignore)) + (should-not (test-completion "def" +abba #'ignore)) + (should-not (test-completion "abba" +abba #'ignore)) + (should-not (test-completion "abcd" +abba #'ignore)))) + +(defun minibuf-tests--test-completion-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (test-completion "abc" abcdef)) + (should (test-completion "def" +abba)) + (should (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba))) + (let ((completion-regexp-list '("X"))) + (should-not (test-completion "abc" abcdef)) + (should-not (test-completion "def" +abba)) + (should-not (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba))))) + + +;;; Tests for `try-completion'. +(ert-deftest try-completion-string-list () + (minibuf-tests--try-completion #'identity)) +(ert-deftest try-completion-string-list-predicate () + (minibuf-tests--try-completion-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-string-list-completion-regexp () + (minibuf-tests--try-completion-regexp #'identity)) + +(ert-deftest try-completion-symbol-list () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest try-completion-symbol-list-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-symbol-list-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest try-completion-symbol-alist () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest try-completion-symbol-alist-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-symbol-alist-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest try-completion-string-alist () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest try-completion-string-alist-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-string-alist-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest try-completion-obarray () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-obarray)) +(ert-deftest try-completion-obarray-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest try-completion-obarray-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest try-completion-string-hashtable () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest try-completion-string-hashtable-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest try-completion-string-hashtable-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest try-completion-symbol-hashtable () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest try-completion-symbol-hashtable-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest try-completion-symbol-hashtable-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; Tests for `all-completions'. + +(ert-deftest all-completions-string-list () + (minibuf-tests--all-completions #'identity)) +(ert-deftest all-completions-string-list-predicate () + (minibuf-tests--all-completions-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-string-list-completion-regexp () + (minibuf-tests--all-completions-regexp #'identity)) + +(ert-deftest all-completions-symbol-list () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest all-completions-symbol-list-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-symbol-list-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest all-completions-symbol-alist () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest all-completions-symbol-alist-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-symbol-alist-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest all-completions-string-alist () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest all-completions-string-alist-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-string-alist-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest all-completions-obarray () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-obarray)) +(ert-deftest all-completions-obarray-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest all-completions-obarray-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest all-completions-string-hashtable () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest all-completions-string-hashtable-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest all-completions-string-hashtable-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest all-completions-symbol-hashtable () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest all-completions-symbol-hashtable-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest all-completions-symbol-hashtable-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; Tests for `test-completion'. + +(ert-deftest test-completion-string-list () + (minibuf-tests--test-completion #'identity)) +(ert-deftest test-completion-string-list-predicate () + (minibuf-tests--test-completion-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-string-list-completion-regexp () + (minibuf-tests--test-completion-regexp #'identity)) + +(ert-deftest test-completion-symbol-list () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest test-completion-symbol-list-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-symbol-list-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest test-completion-symbol-alist () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest test-completion-symbol-alist-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-symbol-alist-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest test-completion-string-alist () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest test-completion-string-alist-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-string-alist-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest test-completion-obarray () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-obarray)) +(ert-deftest test-completion-obarray-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest test-completion-obarray-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest test-completion-string-hashtable () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest test-completion-string-hashtable-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest test-completion-string-hashtable-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest test-completion-symbol-hashtable () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest test-completion-symbol-hashtable-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-hashtable + ;; The predicate recieves a string as the key in this case. + (lambda (table) + (let ((in-table (minibuf-tests--part-of-hashtable table))) + (lambda (k v) (funcall in-table (intern k) v)))))) +(ert-deftest test-completion-symbol-hashtable-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; minibuf-tests.el ends here -- 2.9.3 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v1-0002-Give-test-completion-s-PREDICATE-the-hashtable-ke.patch Content-Description: patch >From 6b587c804c6a98b30de984e58e56b9ba3794810a Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 27 Nov 2016 14:41:02 -0500 Subject: [PATCH v1 2/2] Give test-completion's PREDICATE the hashtable key For hashtable entries with symbol keys, `test-completion' would convert the key to a string before calling PREDICATE, unlike `try-completion' and `all-completions'. * src/minibuf.c (Ftest_completion): Pass original key from hashtable. --- src/minibuf.c | 23 ++++++++++++----------- test/src/minibuf-tests.el | 5 +---- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/minibuf.c b/src/minibuf.c index 6c694cb..7c5af34 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1736,26 +1736,27 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0, else if (HASH_TABLE_P (collection)) { struct Lisp_Hash_Table *h = XHASH_TABLE (collection); - Lisp_Object key = Qnil; i = hash_lookup (h, string, NULL); if (i >= 0) + { tem = HASH_KEY (h, i); + goto found_matching_key; + } else for (i = 0; i < HASH_TABLE_SIZE (h); ++i) - if (!NILP (HASH_HASH (h, i)) - && (key = HASH_KEY (h, i), - SYMBOLP (key) ? key = Fsymbol_name (key) : key, - STRINGP (key)) - && EQ (Fcompare_strings (string, make_number (0), Qnil, - key, make_number (0) , Qnil, + { + if (NILP (HASH_HASH (h, i))) continue; + tem = HASH_KEY (h, i); + Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem); + if (!STRINGP (strkey)) continue; + if (EQ (Fcompare_strings (string, Qnil, Qnil, + strkey, Qnil, Qnil, completion_ignore_case ? Qt : Qnil), Qt)) - { - tem = key; - break; + goto found_matching_key; } - if (!STRINGP (tem)) return Qnil; + found_matching_key: ; } else return call3 (collection, string, predicate, Qlambda); diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 98b8614..82ac037 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -394,10 +394,7 @@ minibuf-tests--test-completion-regexp (ert-deftest test-completion-symbol-hashtable-predicate () (minibuf-tests--test-completion-pred #'minibuf-tests--strings-to-symbol-hashtable - ;; The predicate recieves a string as the key in this case. - (lambda (table) - (let ((in-table (minibuf-tests--part-of-hashtable table))) - (lambda (k v) (funcall in-table (intern k) v)))))) + #'minibuf-tests--part-of-hashtable)) (ert-deftest test-completion-symbol-hashtable-completion-regexp () (minibuf-tests--test-completion-regexp #'minibuf-tests--strings-to-symbol-hashtable)) -- 2.9.3 --=-=-=--