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: Mon, 28 Nov 2016 22:31:32 -0500 Message-ID: <878ts3hsh7.fsf@users.sourceforge.net> References: <87shqnpxym.fsf@udel.edu> <87fumljw98.fsf@users.sourceforge.net> <87eg1wisck.fsf_-_@users.sourceforge.net> <20161128205917.GA17197@holos.localdomain> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1480390279 19508 195.159.176.226 (29 Nov 2016 03:31:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 29 Nov 2016 03:31:19 +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 Tue Nov 29 04:31:14 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 1cBZ8T-0003pF-Fg for geb-bug-gnu-emacs@m.gmane.org; Tue, 29 Nov 2016 04:31:13 +0100 Original-Received: from localhost ([::1]:34324 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cBZ8X-0003Br-Ch for geb-bug-gnu-emacs@m.gmane.org; Mon, 28 Nov 2016 22:31:17 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:46147) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cBZ8N-0003Ba-O5 for bug-gnu-emacs@gnu.org; Mon, 28 Nov 2016 22:31:10 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cBZ8I-0004D1-Ns for bug-gnu-emacs@gnu.org; Mon, 28 Nov 2016 22:31:07 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:58278) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cBZ8I-0004Cr-IT for bug-gnu-emacs@gnu.org; Mon, 28 Nov 2016 22:31:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cBZ8I-0005bG-6h for bug-gnu-emacs@gnu.org; Mon, 28 Nov 2016 22:31: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: Tue, 29 Nov 2016 03:31: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 patch Original-Received: via spool by 24966-submit@debbugs.gnu.org id=B24966.148039024621503 (code B ref 24966); Tue, 29 Nov 2016 03:31:02 +0000 Original-Received: (at 24966) by debbugs.gnu.org; 29 Nov 2016 03:30:46 +0000 Original-Received: from localhost ([127.0.0.1]:45444 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cBZ81-0005al-KU for submit@debbugs.gnu.org; Mon, 28 Nov 2016 22:30:46 -0500 Original-Received: from mail-io0-f170.google.com ([209.85.223.170]:33553) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cBZ7y-0005aU-Qc for 24966@debbugs.gnu.org; Mon, 28 Nov 2016 22:30:43 -0500 Original-Received: by mail-io0-f170.google.com with SMTP id j65so268517192iof.0 for <24966@debbugs.gnu.org>; Mon, 28 Nov 2016 19:30:42 -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=XdaYar8lwH5bKHECudxHft45+Y3HE8cl9m9fYu6dVsc=; b=DoANOgL5rvuDiN2HurmEoXWKKwq1LySGVctdJRki/tXwur5x9oxvE0P8jWSSr7LoiD DUh/3BrbUMZGCVZSsENvWzTsHemHh1KMd1JWM5LwqhQ5lqA4M6M3K0e7SGZ/++MttMbR taNseUzRXT7BJgcfNk/hK48WzwH8LARPKe1nO2waRe3v5uHiG8YCjoefltf58ifWT0Ax dhuqllkL1bQZR4oaM2hnMfaZLEQQqcxcHzOeO0EYXoGuDP6eXhdLAZ5jZIVPRo4/t5CY gaH9bHiZK0FT6mnuQl0ACgE3Oky9p+zycEVAgvGTGsErbgbR/ZAl1l6AgTc65NSCOsem bfOg== 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=XdaYar8lwH5bKHECudxHft45+Y3HE8cl9m9fYu6dVsc=; b=KhZkIudsMHQxyOaO8Hkg39bcfTj0TPLBmgABKMXuf4DzXrNggZHO55V/8Z5jI8n+6q F2EW3hNAMl2w5Ie4eR7TNvr9bR+gK+4L1C0fZ6CV6x2EoBO+eVSZ8knkALshrROvHx/B xIUe04GEcGk3sqVbxhuwwfA+/vicoxgToRVbgnkJAEmzilicNxUZAHyO/OI/1GPEqwvN Xz/k8z7re+TIT7DjNtOA2foVQYTKGuC99Sg1wBqudI6JMFuHyKn6MTbbazhYwLK2hYi8 Z7bzjzLX3L5aXnU7sYKxygMhmAOsSRxSiAqbUBo4/8sJalZUE0etXJyu6r/qbFMpf75j g2DQ== X-Gm-Message-State: AKaTC01RUU7CCBUIN6NIodoYABL6owgUdwVwdEn+ouhCa6PncXi75IOHYkWDkpGDtqi4cA== X-Received: by 10.107.131.195 with SMTP id n64mr22425474ioi.161.1480390236946; Mon, 28 Nov 2016 19:30:36 -0800 (PST) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id r9sm641480ita.0.2016.11.28.19.30.35 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 28 Nov 2016 19:30:36 -0800 (PST) In-Reply-To: (Noam Postavsky's message of "Mon, 28 Nov 2016 16:03:29 -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:126227 Archived-At: --=-=-= Content-Type: text/plain Noam Postavsky writes: > On Mon, Nov 28, 2016 at 3:59 PM, Mark Oteiza wrote: >>> >>> 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. >> >> The first hunk of 2/2 isn't applying here. > > Oh, that's probably because I generated it with -w, so some whitespace > changes are missing in 1/2. I'll post a full patch tonight. Here are the same patches with full whitespace changes. --=-=-= 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 | 33 +++++++++++++++++---------------- test/src/minibuf-tests.el | 5 +---- 2 files changed, 18 insertions(+), 20 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); + { + 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, - completion_ignore_case ? Qt : Qnil), - Qt)) - { - tem = key; - break; - } - if (!STRINGP (tem)) - return 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)) + goto found_matching_key; + } + 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 --=-=-=--