New function 'hash-table-contains-p'

This function tests whether a given key is present in a hash table.
Emacs Lisp has long lacked a standard way to do this, leading users to
write one of:

    (not (eq (gethash key table 'missing) 'missing))
or
    (gethash key table)

This idiom is error-prone (when 'missing' or 'nil' are valid values),
and it obscures intent.  The new function avoids such pitfalls,
improves readability, and makes the intent explicit:

    (hash-table-contains-p key table)

The name 'hash-table-contains-p' exists in other Lisp dialects (e.g.,
SRFI-125), and follows the precedent of 'seq-contains-p'.  Other
alternatives considered include `hash-table-has-key-p` and
`hash-table-key-exists-p`, but none were clearly better.

This was previously discussed in 2018, and all comments were positive,
but the proposed patch (implementing it in C) was never pushed:
https://lists.gnu.org/r/emacs-devel/2018-02/msg00424.html

* lisp/subr.el (hash-table-contains-p): New function.
* lisp/emacs-lisp/shortdoc.el (hash-table):
* doc/lispref/hash.texi (Other Hash): Document the new function.
* test/lisp/subr-tests.el (hash-table-contains-p): New test.

(cherry picked from commit dd0dd87e3aaf3116c400fba858cbe35ced15f04e)

diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index f429d1512fd0291206bc25e9a09994f396f945e5..56862a9d93471869879b3fb7f5af168c2bb2f601 100644 (file)
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -347,6 +347,11 @@ itself is copied---the keys and values are shared.
 This function returns the actual number of entries in @var{table}.
 @end defun
 
+@defun hash-table-contains-p key table
+This returns non-@code{nil} if there is an association for @var{key} in
+@var{table}.
+@end defun
+
 @defun hash-table-test table
 This returns the @var{test} value that was given when @var{table} was
 created, to specify how to hash and compare keys.  See

diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 91de1aaf6ee13e59a70243dd22312dbf2a4d727b..482630b91af3c429b9f3d68118744cd810237e1c 100644 (file)
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -710,6 +710,8 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
   "Other Hash Table Functions"
   (hash-table-p
    :eval (hash-table-p 123))
+  (hash-table-contains-p
+   :no-eval (hash-table-contains-p 'key table))
   (copy-hash-table
    :no-eval (copy-hash-table table)
    :result-string "#s(hash-table ...)")

diff --git a/lisp/subr.el b/lisp/subr.el
index 7ccf1f938ec5a129ef42297ba5339dac6ad2c241..0f5de9c9c0483073e6103cb695bdd6171e041d0d 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6873,6 +6873,13 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
   (declare (important-return-value t))
   (string-trim-left (string-trim-right string trim-right) trim-left))
 
+(defsubst hash-table-contains-p (key table)
+  "Return non-nil if TABLE has an element with KEY."
+  (declare (side-effect-free t)
+           (important-return-value t))
+  (let ((missing (make-symbol "missing")))
+    (not (eq (gethash key table missing) missing))))
+
 ;; The initial anchoring is for better performance in searching matches.
 (defconst regexp-unmatchable "\\`a\\`"
   "Standard regexp guaranteed not to match any string at all.")

diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index df45b1f8a10bacdcc5332adbb1773bb77dbc2655..25f1b3403cad857a1ddc979596840482370c9435 100644 (file)
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1489,70 +1489,17 @@ final or penultimate step during initialization."))
                  (props-out (object-intervals out)))
             (should (equal props-out props-in))))))))
 
-(ert-deftest subr-tests-internal--c-header-file-path ()
-  (should (seq-every-p #'stringp (internal--c-header-file-path)))
-  (should (locate-file "stdio.h" (internal--c-header-file-path)))
-  (or (memq system-type '(windows-nt ms-dos))
-      (should (member "/usr/include" (internal--c-header-file-path))))
-  (should (equal (internal--c-header-file-path)
-                 (delete-dups (internal--c-header-file-path))))
-  ;; Return a meaningful result even if calling some compiler fails.
-  (cl-letf (((symbol-function 'call-process)
-             (lambda (_program &optional _infile _destination _display &rest _args) 1)))
-    (should (seq-every-p #'stringp (internal--c-header-file-path)))
-    (should (member (expand-file-name "/usr/include")
-                    (internal--c-header-file-path)))
-    (should (equal (internal--c-header-file-path)
-                   (delete-dups (internal--c-header-file-path))))))
-
-(ert-deftest subr-tests-internal--c-header-file-path/gcc-mocked ()
-  ;; Handle empty values of "gcc -print-multiarch".
-  (cl-letf (((symbol-function 'call-process)
-             (lambda (_program &optional _infile _destination _display &rest args)
-               (when (equal (car args) "-print-multiarch")
-                 (insert "\n") 0))))
-    (should (member (expand-file-name "/usr/include")
-                    (internal--c-header-file-path))))
-  ;; Handle single values of "gcc -print-multiarch".
-  (cl-letf ((system-type 'foo)
-            ((symbol-function 'call-process)
-             (lambda (_program &optional _infile _destination _display &rest args)
-               (when (equal (car args) "-print-multiarch")
-                 (insert "x86_64-linux-gnu\n") 0))))
-    (should (member (expand-file-name "/usr/include/x86_64-linux-gnu")
-                    (internal--c-header-file-path)))))
-
-(ert-deftest subr-tests-internal--c-header-file-path/clang-mocked ()
-  ;; Handle clang 15.0.0 output on macOS 15.2.
-  (cl-letf (((symbol-function 'internal--gcc-is-clang-p) (lambda () t))
-            ((symbol-function 'call-process)
-             (lambda (_program &optional _infile _destination _display &rest _args)
-               (insert "\
-Apple clang version 15.0.0 (clang-1500.3.9.4)
-Target: arm64-apple-darwin24.2.0
-Thread model: posix
-InstalledDir: /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin
- \"/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang\"
-[[[...Emacs test omits some verbose junk from the output here...]]]
-clang -cc1 version 15.0.0 (clang-1500.3.9.4) default target arm64-apple-darwin24.2.0
-ignoring nonexistent directory \"/usr/local/include\"
-#include \"...\" search starts here:
-#include <...> search starts here:
- /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include
- /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include
- /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include
- /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/System/Library/Frameworks (framework directory)
-End of search list.
-# 1 \"<stdin>\"
-# 1 \"<built-in>\" 1
-# 1 \"<built-in>\" 3
-# 418 \"<built-in>\" 3
-# 1 \"<command line>\" 1
-# 1 \"<built-in>\" 2
-# 1 \"<stdin>\" 2")
-               0)))
-    (should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include")
-                    (internal--c-header-file-path)))))
+(ert-deftest hash-table-contains-p ()
+  (let ((h (make-hash-table)))
+    (should-not (hash-table-contains-p 'problems h))
+    (should-not (hash-table-contains-p 'cookie h))
+    (should-not (hash-table-contains-p 'milk h))
+    (puthash 'problems 99 h)
+    (puthash 'cookie nil h)
+    (puthash 'milk 'missing h)
+    (should (hash-table-contains-p 'problems h))
+    (should (hash-table-contains-p 'cookie h))
+    (should (hash-table-contains-p 'milk h))))
 
 (provide 'subr-tests)
 ;;; subr-tests.el ends here