unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: npostavs@users.sourceforge.net
To: Mark Oteiza <mvoteiza@udel.edu>
Cc: 24966@debbugs.gnu.org
Subject: bug#24966: 26.0.50; test-completion with alist COLLECTION calls PREDICATE incorrectly
Date: Mon, 28 Nov 2016 22:31:32 -0500	[thread overview]
Message-ID: <878ts3hsh7.fsf@users.sourceforge.net> (raw)
In-Reply-To: <CAM-tV-_aYQiaLcOGkcyrnkp6=92s-sYw9d82cdxN2EfoSDupFA@mail.gmail.com> (Noam Postavsky's message of "Mon, 28 Nov 2016 16:03:29 -0500")

[-- Attachment #1: Type: text/plain, Size: 866 bytes --]

Noam Postavsky <npostavs@users.sourceforge.net> writes:

> On Mon, Nov 28, 2016 at 3:59 PM, Mark Oteiza <mvoteiza@udel.edu> 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.


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 20004 bytes --]

From ba3f1477e66536fd759c4f7128bfbca009532b14 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
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 <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+\f
+;;; 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)))
+
+\f
+;;; 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)))))
+
+\f
+;;; 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))
+
+\f
+;;; 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))
+
+\f
+;;; 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))
+
+\f
+;;; minibuf-tests.el ends here
-- 
2.9.3


[-- Attachment #3: patch --]
[-- Type: text/plain, Size: 3014 bytes --]

From 6b587c804c6a98b30de984e58e56b9ba3794810a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
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


  reply	other threads:[~2016-11-29  3:31 UTC|newest]

Thread overview: 10+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2016-11-19 10:26 bug#24966: 26.0.50; Mark Oteiza
2016-11-21  4:24 ` npostavs
2016-11-21 19:42   ` Mark Oteiza
2016-11-27 20:24   ` bug#24966: 26.0.50; test-completion with alist COLLECTION calls PREDICATE incorrectly npostavs
2016-11-28 20:59     ` Mark Oteiza
2016-11-28 21:03       ` Noam Postavsky
2016-11-29  3:31         ` npostavs [this message]
2016-11-30  2:04           ` Mark Oteiza
2016-12-06  1:50             ` Mark Oteiza
2016-12-07  3:31               ` npostavs

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=878ts3hsh7.fsf@users.sourceforge.net \
    --to=npostavs@users.sourceforge.net \
    --cc=24966@debbugs.gnu.org \
    --cc=mvoteiza@udel.edu \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).