From: Stefan Kangas Date: Sat, 29 Mar 2025 13:59:26 +0000 (+0100) Subject: New function 'hash-table-contains-p' X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=273cc5055ea3c554d3249e834ea62f2808f65bf0;p=emacs.git 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 f429d1512fd..56862a9d934 100644 --- 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 91de1aaf6ee..482630b91af 100644 --- 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 7ccf1f938ec..0f5de9c9c04 100644 --- 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 df45b1f8a10..25f1b3403ca 100644 --- 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 \"\" -# 1 \"\" 1 -# 1 \"\" 3 -# 418 \"\" 3 -# 1 \"\" 1 -# 1 \"\" 2 -# 1 \"\" 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