Audit some plist uses with new predicate argument
* doc/lispref/lists.texi (Plist Access): Improve description of default predicate. * lisp/emacs-lisp/cl-extra.el (cl-getf, cl--set-getf): Assume plist-member always returns a cons. * lisp/emacs-lisp/gv.el (plist-get): Support new optional predicate argument (bug#47425#91). * lisp/emacs-lisp/map.el: Bump minor version. (map--dispatch): Remove now that bug#58563 is fixed. Break two remaining uses out into corresponding cl-defmethods. (map--plist-p): Add docstring. (map--plist-has-predicate, map--plist-member-1, map--plist-member) (map--plist-put-1, map--plist-put): New definitions for supporting predicate argument backward compatibly. (map-elt): Fix generalized variable getter under a predicate (bug#58531). Use predicate when given a plist. (map-put): Avoid gratuitous warnings when called without the hidden predicate argument. Improve obsoletion message. (map-put!): Use predicate when given a plist. (map-contains-key): Ditto. Declare forgotten advertised-calling-convention (bug#58531#19). (map--put): Group definition in file together with that of map-put!. * lisp/files-x.el (connection-local-normalize-criteria): Simplify using mapcan + plist-get. * lisp/net/eudc.el (eudc--plist-member): New convenience function. (eudc-plist-member, eudc-plist-get, eudc-lax-plist-get): Use it instead of open-coding plist-member. * src/fns.c (Fplist_get, plist_get, Fplist_put, plist_put): Pass the plist element as the first argument to the predicate, for consistency with assoc + alist-get. (Fplist_member, plist_member): Move from widget to plist section. Open-code the EQ case in plist_member, and call it from Fplist_member in that case, rather than the other way around. * test/lisp/apropos-tests.el (apropos-tests-format-plist): Avoid polluting obarray. * test/lisp/emacs-lisp/cl-extra-tests.el (cl-getf): Extend test with generalized variables, degenerate plists, and improper lists. * test/lisp/emacs-lisp/gv-tests.el: Byte-compile file; in the meantime bug#24402 seems to have been fixed or worked around. (gv-setter-edebug): Inhibit printing messages. (gv-plist-get): Avoid modifying constant literals. Also test with a predicate argument. * test/lisp/emacs-lisp/map-tests.el (with-maps-do): Simplify docstring. (test-map-elt-testfn): Rename... (test-map-elt-testfn-alist): ...to this. Also test with a predicate argument. (test-map-elt-testfn-plist, test-map-elt-gv, test-map-elt-signature) (test-map-put!-plist, test-map-put!-signature) (test-map-contains-key-signature, test-map-plist-member) (test-map-plist-put): New tests. (test-map-contains-key-testfn): Also test with a predicate argument. (test-map-setf-alist-overwrite-key, test-map-setf-plist-insert-key) (test-map-setf-plist-overwrite-key): Avoid modifying constant literals. (test-hash-table-setf-insert-key) (test-hash-table-setf-overwrite-key): Fix indentation. (test-setf-map-with-function): Make test more precise. * test/lisp/net/eudc-tests.el: New file. * test/lisp/subr-tests.el (test-plistp): Extend test with circular list. * test/src/fns-tests.el (test-cycle-equal, test-cycle-nconc): Move from plist section to circular list section. (plist-put/odd-number-of-elements): Avoid modifying constant literals. (plist-member/improper-list): Simplify. (test-plist): Move to plist section. Also test with a predicate argument.
This commit is contained in:
Basil L. Contovounesios
parent
f85bdb4992
commit
9da2efb670
14 changed files with 649 additions and 250 deletions
|
|
@ -1961,12 +1961,12 @@ and later discarded; this is not possible with a property list.
|
|||
@cindex accessing plist properties
|
||||
|
||||
The following functions can be used to manipulate property lists.
|
||||
They all compare property names using @code{eq}.
|
||||
They all default to comparing property names using @code{eq}.
|
||||
|
||||
@defun plist-get plist property &optional predicate
|
||||
This returns the value of the @var{property} property stored in the
|
||||
property list @var{plist}. Comparisons are done with @var{predicate},
|
||||
and defaults to @code{eq}. It accepts a malformed @var{plist}
|
||||
which defaults to @code{eq}. It accepts a malformed @var{plist}
|
||||
argument. If @var{property} is not found in the @var{plist}, it
|
||||
returns @code{nil}. For example,
|
||||
|
||||
|
|
@ -1985,7 +1985,7 @@ returns @code{nil}. For example,
|
|||
@defun plist-put plist property value &optional predicate
|
||||
This stores @var{value} as the value of the @var{property} property in
|
||||
the property list @var{plist}. Comparisons are done with @var{predicate},
|
||||
and defaults to @code{eq}. It may modify @var{plist} destructively,
|
||||
which defaults to @code{eq}. It may modify @var{plist} destructively,
|
||||
or it may construct a new list structure without altering the old. The
|
||||
function returns the modified property list, so you can store that back
|
||||
in the place where you got @var{plist}. For example,
|
||||
|
|
@ -2012,7 +2012,7 @@ compares properties using @code{equal} instead of @code{eq}.
|
|||
|
||||
@defun plist-member plist property &optional predicate
|
||||
This returns non-@code{nil} if @var{plist} contains the given
|
||||
@var{property}. Comparisons are done with @var{predicate}, and
|
||||
@var{property}. Comparisons are done with @var{predicate}, which
|
||||
defaults to @code{eq}. Unlike @code{plist-get}, this allows you to
|
||||
distinguish between a missing property and a property with the value
|
||||
@code{nil}. The value is actually the tail of @var{plist} whose
|
||||
|
|
|
|||
|
|
@ -615,12 +615,12 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
,(funcall setter
|
||||
`(cl--set-getf ,getter ,k ,val))
|
||||
,val)))))))))
|
||||
(let ((val-tail (cdr-safe (plist-member plist tag))))
|
||||
(let ((val-tail (cdr (plist-member plist tag))))
|
||||
(if val-tail (car val-tail) def)))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--set-getf (plist tag val)
|
||||
(let ((val-tail (cdr-safe (plist-member plist tag))))
|
||||
(let ((val-tail (cdr (plist-member plist tag))))
|
||||
(if val-tail (progn (setcar val-tail val) plist)
|
||||
(cl-list* tag val plist))))
|
||||
|
||||
|
|
|
|||
|
|
@ -445,16 +445,17 @@ The return value is the last VAL in the list.
|
|||
,v))))))))))
|
||||
|
||||
(gv-define-expander plist-get
|
||||
(lambda (do plist prop)
|
||||
(lambda (do plist prop &optional predicate)
|
||||
(macroexp-let2 macroexp-copyable-p key prop
|
||||
(gv-letplace (getter setter) plist
|
||||
(macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
|
||||
(macroexp-let2 nil p `(cdr (plist-member ,getter ,key ,predicate))
|
||||
(funcall do
|
||||
`(car ,p)
|
||||
(lambda (val)
|
||||
`(if ,p
|
||||
(setcar ,p ,val)
|
||||
,(funcall setter `(cons ,key (cons ,val ,getter)))))))))))
|
||||
,(funcall setter
|
||||
`(cons ,key (cons ,val ,getter)))))))))))
|
||||
|
||||
;;; Some occasionally handy extensions.
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
;; Author: Nicolas Petton <nicolas@petton.fr>
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
;; Keywords: extensions, lisp
|
||||
;; Version: 3.2.1
|
||||
;; Version: 3.3.1
|
||||
;; Package-Requires: ((emacs "26"))
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
|
@ -80,48 +80,82 @@ MAP can be an alist, plist, hash-table, or array."
|
|||
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
|
||||
,@body))
|
||||
|
||||
(eval-when-compile
|
||||
(defmacro map--dispatch (map-var &rest args)
|
||||
"Evaluate one of the forms specified by ARGS based on the type of MAP-VAR.
|
||||
|
||||
The following keyword types are meaningful: `:list',
|
||||
`:hash-table' and `:array'.
|
||||
|
||||
An error is thrown if MAP-VAR is neither a list, hash-table nor array.
|
||||
|
||||
Returns the result of evaluating the form associated with MAP-VAR's type."
|
||||
(declare (debug t) (indent 1))
|
||||
`(cond ((listp ,map-var) ,(plist-get args :list))
|
||||
((hash-table-p ,map-var) ,(plist-get args :hash-table))
|
||||
((arrayp ,map-var) ,(plist-get args :array))
|
||||
(t (error "Unsupported map type `%S': %S"
|
||||
(type-of ,map-var) ,map-var)))))
|
||||
|
||||
(define-error 'map-not-inplace "Cannot modify map in-place")
|
||||
|
||||
(defsubst map--plist-p (list)
|
||||
"Return non-nil if LIST is the start of a nonempty plist map."
|
||||
(and (consp list) (atom (car list))))
|
||||
|
||||
(defconst map--plist-has-predicate
|
||||
(condition-case nil
|
||||
(with-no-warnings (plist-get () nil #'eq) t)
|
||||
(wrong-number-of-arguments))
|
||||
"Non-nil means `plist-get' & co. accept a predicate in Emacs 29+.
|
||||
Note that support for this predicate in map.el is patchy and
|
||||
deprecated.")
|
||||
|
||||
(defun map--plist-member-1 (plist prop &optional predicate)
|
||||
"Compatibility shim for the PREDICATE argument of `plist-member'.
|
||||
Assumes non-nil PLIST satisfies `map--plist-p'."
|
||||
(if (or (memq predicate '(nil eq)) (null plist))
|
||||
(plist-member plist prop)
|
||||
(let ((tail plist) found)
|
||||
(while (and (not (setq found (funcall predicate (car tail) prop)))
|
||||
(consp (setq tail (cdr tail)))
|
||||
(consp (setq tail (cdr tail)))))
|
||||
(and tail (not found)
|
||||
(signal 'wrong-type-argument `(plistp ,plist)))
|
||||
tail)))
|
||||
|
||||
(defalias 'map--plist-member
|
||||
(if map--plist-has-predicate #'plist-member #'map--plist-member-1)
|
||||
"Compatibility shim for `plist-member' in Emacs 29+.
|
||||
\n(fn PLIST PROP &optional PREDICATE)")
|
||||
|
||||
(defun map--plist-put-1 (plist prop val &optional predicate)
|
||||
"Compatibility shim for the PREDICATE argument of `plist-put'.
|
||||
Assumes non-nil PLIST satisfies `map--plist-p'."
|
||||
(if (or (memq predicate '(nil eq)) (null plist))
|
||||
(plist-put plist prop val)
|
||||
(let ((tail plist) prev found)
|
||||
(while (and (consp (cdr tail))
|
||||
(not (setq found (funcall predicate (car tail) prop)))
|
||||
(consp (setq prev tail tail (cddr tail)))))
|
||||
(cond (found (setcar (cdr tail) val))
|
||||
(tail (signal 'wrong-type-argument `(plistp ,plist)))
|
||||
(prev (setcdr (cdr prev) (cons prop (cons val (cddr prev)))))
|
||||
((setq plist (cons prop (cons val plist)))))
|
||||
plist)))
|
||||
|
||||
(defalias 'map--plist-put
|
||||
(if map--plist-has-predicate #'plist-put #'map--plist-put-1)
|
||||
"Compatibility shim for `plist-put' in Emacs 29+.
|
||||
\n(fn PLIST PROP VAL &optional PREDICATE)")
|
||||
|
||||
(cl-defgeneric map-elt (map key &optional default testfn)
|
||||
"Look up KEY in MAP and return its associated value.
|
||||
If KEY is not found, return DEFAULT which defaults to nil.
|
||||
|
||||
TESTFN is the function to use for comparing keys. It is
|
||||
deprecated because its default and valid values depend on the MAP
|
||||
argument. Generally, alist keys are compared with `equal', plist
|
||||
keys with `eq', and hash-table keys with the hash-table's test
|
||||
argument, and it was never consistently supported by the map.el
|
||||
API. Generally, alist keys are compared with `equal', plist keys
|
||||
with `eq', and hash-table keys with the hash-table's test
|
||||
function.
|
||||
|
||||
In the base definition, MAP can be an alist, plist, hash-table,
|
||||
or array."
|
||||
(declare
|
||||
;; `testfn' is deprecated.
|
||||
(advertised-calling-convention (map key &optional default) "27.1")
|
||||
(gv-expander
|
||||
(lambda (do)
|
||||
(gv-letplace (mgetter msetter) `(gv-delay-error ,map)
|
||||
(macroexp-let2* nil
|
||||
;; Eval them once and for all in the right order.
|
||||
((key key) (default default) (testfn testfn))
|
||||
(funcall do `(map-elt ,mgetter ,key ,default)
|
||||
(funcall do
|
||||
`(map-elt ,mgetter ,key ,default ,@(and testfn `(,testfn)))
|
||||
(lambda (v)
|
||||
(macroexp-let2 nil v v
|
||||
`(condition-case nil
|
||||
|
|
@ -132,19 +166,21 @@ or array."
|
|||
,(funcall msetter
|
||||
`(map-insert ,mgetter ,key ,v))
|
||||
;; Always return the value.
|
||||
,v)))))))))
|
||||
;; `testfn' is deprecated.
|
||||
(advertised-calling-convention (map key &optional default) "27.1"))
|
||||
;; Can't use `cl-defmethod' with `advertised-calling-convention'.
|
||||
(map--dispatch map
|
||||
:list (if (map--plist-p map)
|
||||
(let ((res (plist-member map key)))
|
||||
(if res (cadr res) default))
|
||||
(alist-get key map default nil (or testfn #'equal)))
|
||||
:hash-table (gethash key map default)
|
||||
:array (if (map-contains-key map key)
|
||||
(aref map key)
|
||||
default)))
|
||||
,v)))))))))))
|
||||
|
||||
(cl-defmethod map-elt ((map list) key &optional default testfn)
|
||||
(if (map--plist-p map)
|
||||
(let ((res (map--plist-member map key testfn)))
|
||||
(if res (cadr res) default))
|
||||
(alist-get key map default nil (or testfn #'equal))))
|
||||
|
||||
(cl-defmethod map-elt ((map hash-table) key &optional default _testfn)
|
||||
(gethash key map default))
|
||||
|
||||
(cl-defmethod map-elt ((map array) key &optional default _testfn)
|
||||
(if (map-contains-key map key)
|
||||
(aref map key)
|
||||
default))
|
||||
|
||||
(defmacro map-put (map key value &optional testfn)
|
||||
"Associate KEY with VALUE in MAP and return VALUE.
|
||||
|
|
@ -154,8 +190,12 @@ When MAP is an alist, test equality with TESTFN if non-nil,
|
|||
otherwise use `equal'.
|
||||
|
||||
MAP can be an alist, plist, hash-table, or array."
|
||||
(declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
|
||||
`(setf (map-elt ,map ,key nil ,testfn) ,value))
|
||||
(declare
|
||||
(obsolete "use `map-put!' or `(setf (map-elt ...) ...)' instead." "27.1"))
|
||||
(if testfn
|
||||
`(with-no-warnings
|
||||
(setf (map-elt ,map ,key nil ,testfn) ,value))
|
||||
`(setf (map-elt ,map ,key) ,value)))
|
||||
|
||||
(defun map--plist-delete (map key)
|
||||
(let ((tail map) last)
|
||||
|
|
@ -338,15 +378,16 @@ The default implementation delegates to `map-length'."
|
|||
"Return non-nil if and only if MAP contains KEY.
|
||||
TESTFN is deprecated. Its default depends on MAP.
|
||||
The default implementation delegates to `map-some'."
|
||||
(declare (advertised-calling-convention (map key) "27.1"))
|
||||
(unless testfn (setq testfn #'equal))
|
||||
(map-some (lambda (k _v) (funcall testfn key k)) map))
|
||||
|
||||
(cl-defmethod map-contains-key ((map list) key &optional testfn)
|
||||
"Return non-nil if MAP contains KEY.
|
||||
If MAP is an alist, TESTFN defaults to `equal'.
|
||||
If MAP is a plist, `plist-member' is used instead."
|
||||
If MAP is a plist, TESTFN defaults to `eq'."
|
||||
(if (map--plist-p map)
|
||||
(plist-member map key)
|
||||
(map--plist-member map key testfn)
|
||||
(let ((v '(nil)))
|
||||
(not (eq v (alist-get key map v nil (or testfn #'equal)))))))
|
||||
|
||||
|
|
@ -459,24 +500,30 @@ This operates by modifying MAP in place.
|
|||
If it cannot do that, it signals a `map-not-inplace' error.
|
||||
To insert an element without modifying MAP, use `map-insert'."
|
||||
;; `testfn' only exists for backward compatibility with `map-put'!
|
||||
(declare (advertised-calling-convention (map key value) "27.1"))
|
||||
;; Can't use `cl-defmethod' with `advertised-calling-convention'.
|
||||
(map--dispatch
|
||||
map
|
||||
:list
|
||||
(progn
|
||||
(if (map--plist-p map)
|
||||
(plist-put map key value)
|
||||
(let ((oldmap map))
|
||||
(setf (alist-get key map key nil (or testfn #'equal)) value)
|
||||
(unless (eq oldmap map)
|
||||
(signal 'map-not-inplace (list oldmap)))))
|
||||
;; Always return the value.
|
||||
value)
|
||||
:hash-table (puthash key value map)
|
||||
;; FIXME: If `key' is too large, should we signal `map-not-inplace'
|
||||
;; and let `map-insert' grow the array?
|
||||
:array (aset map key value)))
|
||||
(declare (advertised-calling-convention (map key value) "27.1")))
|
||||
|
||||
(cl-defmethod map-put! ((map list) key value &optional testfn)
|
||||
(if (map--plist-p map)
|
||||
(map--plist-put map key value testfn)
|
||||
(let ((oldmap map))
|
||||
(setf (alist-get key map key nil (or testfn #'equal)) value)
|
||||
(unless (eq oldmap map)
|
||||
(signal 'map-not-inplace (list oldmap)))))
|
||||
;; Always return the value.
|
||||
value)
|
||||
|
||||
(cl-defmethod map-put! ((map hash-table) key value &optional _testfn)
|
||||
(puthash key value map))
|
||||
|
||||
(cl-defmethod map-put! ((map array) key value &optional _testfn)
|
||||
;; FIXME: If `key' is too large, should we signal `map-not-inplace'
|
||||
;; and let `map-insert' grow the array?
|
||||
(aset map key value))
|
||||
|
||||
;; There shouldn't be old source code referring to `map--put', yet we do
|
||||
;; need to keep it for backward compatibility with .elc files where the
|
||||
;; expansion of `setf' may call this function.
|
||||
(define-obsolete-function-alias 'map--put #'map-put! "27.1")
|
||||
|
||||
(cl-defgeneric map-insert (map key value)
|
||||
"Return a new map like MAP except that it associates KEY with VALUE.
|
||||
|
|
@ -493,11 +540,6 @@ The default implementation defaults to `map-copy' and `map-put!'."
|
|||
(cons key (cons value map))
|
||||
(cons (cons key value) map)))
|
||||
|
||||
;; There shouldn't be old source code referring to `map--put', yet we do
|
||||
;; need to keep it for backward compatibility with .elc files where the
|
||||
;; expansion of `setf' may call this function.
|
||||
(define-obsolete-function-alias 'map--put #'map-put! "27.1")
|
||||
|
||||
(cl-defmethod map-apply (function (map list))
|
||||
(if (map--plist-p map)
|
||||
(cl-call-next-method)
|
||||
|
|
|
|||
|
|
@ -635,13 +635,10 @@ of `with-connection-local-variables'.")
|
|||
(defsubst connection-local-normalize-criteria (criteria)
|
||||
"Normalize plist CRITERIA according to properties.
|
||||
Return a reordered plist."
|
||||
(apply
|
||||
#'append
|
||||
(mapcar
|
||||
(lambda (property)
|
||||
(when (and (plist-member criteria property) (plist-get criteria property))
|
||||
(list property (plist-get criteria property))))
|
||||
'(:application :protocol :user :machine))))
|
||||
(mapcan (lambda (property)
|
||||
(let ((value (plist-get criteria property)))
|
||||
(and value (list property value))))
|
||||
'(:application :protocol :user :machine)))
|
||||
|
||||
(defsubst connection-local-get-profiles (criteria)
|
||||
"Return the connection profiles list for CRITERIA.
|
||||
|
|
|
|||
|
|
@ -106,44 +106,40 @@
|
|||
;; Split the string just in case.
|
||||
(version<= "3" (car (split-string bbdb-version)))))
|
||||
|
||||
(defun eudc-plist-member (plist prop)
|
||||
"Return t if PROP has a value specified in PLIST."
|
||||
(if (not (= 0 (% (length plist) 2)))
|
||||
(defun eudc--plist-member (plist prop &optional predicate)
|
||||
"Like `plist-member', but signal on invalid PLIST."
|
||||
;; Could also use `plistp', but that would change the error.
|
||||
(or (zerop (% (length plist) 2))
|
||||
(error "Malformed plist"))
|
||||
(catch 'found
|
||||
(while plist
|
||||
(if (eq prop (car plist))
|
||||
(throw 'found t))
|
||||
(setq plist (cdr (cdr plist))))
|
||||
nil))
|
||||
(plist-member plist prop predicate))
|
||||
|
||||
;; Emacs's plist-get lacks third parameter
|
||||
(defun eudc-plist-member (plist prop)
|
||||
"Return t if PROP has a value specified in PLIST.
|
||||
Signal an error if PLIST is not a valid property list."
|
||||
(and (eudc--plist-member plist prop) t))
|
||||
|
||||
;; Emacs's `plist-get' lacks a default parameter, and CL-Lib's
|
||||
;; `cl-getf' doesn't accept a predicate or signal an error.
|
||||
(defun eudc-plist-get (plist prop &optional default)
|
||||
"Extract a value from a property list.
|
||||
PLIST is a property list, which is a list of the form
|
||||
\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
|
||||
corresponding to the given PROP, or DEFAULT if PROP is not
|
||||
one of the properties on the list."
|
||||
(if (eudc-plist-member plist prop)
|
||||
(plist-get plist prop)
|
||||
default))
|
||||
"Extract the value of PROP in property list PLIST.
|
||||
PLIST is a list of the form (PROP1 VALUE1 PROP2 VALUE2...).
|
||||
This function returns the first value corresponding to the given
|
||||
PROP, or DEFAULT if PROP is not one of the properties in the
|
||||
list. The comparison with PROP is done using `eq'. If PLIST is
|
||||
not a valid property list, this function signals an error."
|
||||
(let ((tail (eudc--plist-member plist prop)))
|
||||
(if tail (cadr tail) default)))
|
||||
|
||||
(defun eudc-lax-plist-get (plist prop &optional default)
|
||||
"Extract a value from a lax property list.
|
||||
|
||||
PLIST is a lax property list, which is a list of the form (PROP1
|
||||
VALUE1 PROP2 VALUE2...), where comparisons between properties are done
|
||||
using `equal' instead of `eq'. This function returns the value
|
||||
corresponding to PROP, or DEFAULT if PROP is not one of the
|
||||
properties on the list."
|
||||
(if (not (= 0 (% (length plist) 2)))
|
||||
(error "Malformed plist"))
|
||||
(catch 'found
|
||||
(while plist
|
||||
(if (equal prop (car plist))
|
||||
(throw 'found (car (cdr plist))))
|
||||
(setq plist (cdr (cdr plist))))
|
||||
default))
|
||||
"Extract the value of PROP from lax property list PLIST.
|
||||
PLIST is a list of the form (PROP1 VALUE1 PROP2 VALUE2...), where
|
||||
comparisons between properties are done using `equal' instead of
|
||||
`eq'. This function returns the first value corresponding to
|
||||
PROP, or DEFAULT if PROP is not one of the properties in the
|
||||
list. If PLIST is not a valid property list, this function
|
||||
signals an error."
|
||||
(let ((tail (eudc--plist-member plist prop #'equal)))
|
||||
(if tail (cadr tail) default)))
|
||||
|
||||
(defun eudc-replace-in-string (str regexp newtext)
|
||||
"Replace all matches in STR for REGEXP with NEWTEXT.
|
||||
|
|
|
|||
97
src/fns.c
97
src/fns.c
|
|
@ -2473,15 +2473,15 @@ with PROP is done using PREDICATE, which defaults to `eq'.
|
|||
This function doesn't signal an error if PLIST is invalid. */)
|
||||
(Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
|
||||
{
|
||||
Lisp_Object tail = plist;
|
||||
if (NILP (predicate))
|
||||
return plist_get (plist, prop);
|
||||
|
||||
Lisp_Object tail = plist;
|
||||
FOR_EACH_TAIL_SAFE (tail)
|
||||
{
|
||||
if (! CONSP (XCDR (tail)))
|
||||
break;
|
||||
if (!NILP (call2 (predicate, prop, XCAR (tail))))
|
||||
if (!NILP (call2 (predicate, XCAR (tail), prop)))
|
||||
return XCAR (XCDR (tail));
|
||||
tail = XCDR (tail);
|
||||
}
|
||||
|
|
@ -2489,7 +2489,7 @@ This function doesn't signal an error if PLIST is invalid. */)
|
|||
return Qnil;
|
||||
}
|
||||
|
||||
/* Faster version of the above that works with EQ only */
|
||||
/* Faster version of Fplist_get that works with EQ only. */
|
||||
Lisp_Object
|
||||
plist_get (Lisp_Object plist, Lisp_Object prop)
|
||||
{
|
||||
|
|
@ -2498,7 +2498,7 @@ plist_get (Lisp_Object plist, Lisp_Object prop)
|
|||
{
|
||||
if (! CONSP (XCDR (tail)))
|
||||
break;
|
||||
if (EQ (prop, XCAR (tail)))
|
||||
if (EQ (XCAR (tail), prop))
|
||||
return XCAR (XCDR (tail));
|
||||
tail = XCDR (tail);
|
||||
}
|
||||
|
|
@ -2532,15 +2532,15 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value.
|
|||
The PLIST is modified by side effects. */)
|
||||
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val, Lisp_Object predicate)
|
||||
{
|
||||
Lisp_Object prev = Qnil, tail = plist;
|
||||
if (NILP (predicate))
|
||||
return plist_put (plist, prop, val);
|
||||
Lisp_Object prev = Qnil, tail = plist;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (! CONSP (XCDR (tail)))
|
||||
break;
|
||||
|
||||
if (!NILP (call2 (predicate, prop, XCAR (tail))))
|
||||
if (!NILP (call2 (predicate, XCAR (tail), prop)))
|
||||
{
|
||||
Fsetcar (XCDR (tail), val);
|
||||
return plist;
|
||||
|
|
@ -2558,6 +2558,7 @@ The PLIST is modified by side effects. */)
|
|||
return plist;
|
||||
}
|
||||
|
||||
/* Faster version of Fplist_put that works with EQ only. */
|
||||
Lisp_Object
|
||||
plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
|
||||
{
|
||||
|
|
@ -2567,7 +2568,7 @@ plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
|
|||
if (! CONSP (XCDR (tail)))
|
||||
break;
|
||||
|
||||
if (EQ (prop, XCAR (tail)))
|
||||
if (EQ (XCAR (tail), prop))
|
||||
{
|
||||
Fsetcar (XCDR (tail), val);
|
||||
return plist;
|
||||
|
|
@ -2595,6 +2596,51 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
|
|||
(symbol, plist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
|
||||
return value;
|
||||
}
|
||||
|
||||
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
|
||||
doc: /* Return non-nil if PLIST has the property PROP.
|
||||
PLIST is a property list, which is a list of the form
|
||||
\(PROP1 VALUE1 PROP2 VALUE2 ...).
|
||||
|
||||
The comparison with PROP is done using PREDICATE, which defaults to
|
||||
`eq'.
|
||||
|
||||
Unlike `plist-get', this allows you to distinguish between a missing
|
||||
property and a property with the value nil.
|
||||
The value is actually the tail of PLIST whose car is PROP. */)
|
||||
(Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
|
||||
{
|
||||
if (NILP (predicate))
|
||||
return plist_member (plist, prop);
|
||||
Lisp_Object tail = plist;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (!NILP (call2 (predicate, XCAR (tail), prop)))
|
||||
return tail;
|
||||
tail = XCDR (tail);
|
||||
if (! CONSP (tail))
|
||||
break;
|
||||
}
|
||||
CHECK_TYPE (NILP (tail), Qplistp, plist);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
/* Faster version of Fplist_member that works with EQ only. */
|
||||
Lisp_Object
|
||||
plist_member (Lisp_Object plist, Lisp_Object prop)
|
||||
{
|
||||
Lisp_Object tail = plist;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (EQ (XCAR (tail), prop))
|
||||
return tail;
|
||||
tail = XCDR (tail);
|
||||
if (! CONSP (tail))
|
||||
break;
|
||||
}
|
||||
CHECK_TYPE (NILP (tail), Qplistp, plist);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
DEFUN ("eql", Feql, Seql, 2, 2, 0,
|
||||
doc: /* Return t if the two args are `eq' or are indistinguishable numbers.
|
||||
|
|
@ -3388,43 +3434,6 @@ FILENAME are suppressed. */)
|
|||
bottleneck of Widget operation. Here is their translation to C,
|
||||
for the sole reason of efficiency. */
|
||||
|
||||
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
|
||||
doc: /* Return non-nil if PLIST has the property PROP.
|
||||
PLIST is a property list, which is a list of the form
|
||||
\(PROP1 VALUE1 PROP2 VALUE2 ...).
|
||||
|
||||
The comparison with PROP is done using PREDICATE, which defaults to
|
||||
`eq'.
|
||||
|
||||
Unlike `plist-get', this allows you to distinguish between a missing
|
||||
property and a property with the value nil.
|
||||
The value is actually the tail of PLIST whose car is PROP. */)
|
||||
(Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
|
||||
{
|
||||
Lisp_Object tail = plist;
|
||||
if (NILP (predicate))
|
||||
predicate = Qeq;
|
||||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
if (!NILP (call2 (predicate, XCAR (tail), prop)))
|
||||
return tail;
|
||||
tail = XCDR (tail);
|
||||
if (! CONSP (tail))
|
||||
break;
|
||||
}
|
||||
CHECK_TYPE (NILP (tail), Qplistp, plist);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
/* plist_member isn't used much in the Emacs sources, so just provide
|
||||
a shim so that the function name follows the same pattern as
|
||||
plist_get/plist_put. */
|
||||
Lisp_Object
|
||||
plist_member (Lisp_Object plist, Lisp_Object prop)
|
||||
{
|
||||
return Fplist_member (plist, prop, Qnil);
|
||||
}
|
||||
|
||||
DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
|
||||
doc: /* In WIDGET, set PROPERTY to VALUE.
|
||||
The value can later be retrieved with `widget-get'. */)
|
||||
|
|
|
|||
|
|
@ -120,14 +120,15 @@
|
|||
(should (apropos-true-hit "foo bar baz" '("foo" "bar"))))
|
||||
|
||||
(ert-deftest apropos-tests-format-plist ()
|
||||
(setplist 'foo '(a 1 b (2 3) c nil))
|
||||
(apropos-parse-pattern '("b"))
|
||||
(should (equal (apropos-format-plist 'foo ", ")
|
||||
"a 1, b (2 3), c nil"))
|
||||
(should (equal (apropos-format-plist 'foo ", " t)
|
||||
"b (2 3)"))
|
||||
(apropos-parse-pattern '("d"))
|
||||
(should-not (apropos-format-plist 'foo ", " t)))
|
||||
(let ((foo (make-symbol "foo")))
|
||||
(setplist foo '(a 1 b (2 3) c nil))
|
||||
(apropos-parse-pattern '("b"))
|
||||
(should (equal (apropos-format-plist foo ", ")
|
||||
"a 1, b (2 3), c nil"))
|
||||
(should (equal (apropos-format-plist foo ", " t)
|
||||
"b (2 3)"))
|
||||
(apropos-parse-pattern '("d"))
|
||||
(should-not (apropos-format-plist foo ", " t))))
|
||||
|
||||
(provide 'apropos-tests)
|
||||
;;; apropos-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -32,8 +32,28 @@
|
|||
(ert-deftest cl-getf ()
|
||||
(let ((plist '(x 1 y nil)))
|
||||
(should (eq (cl-getf plist 'x) 1))
|
||||
(should (eq (cl-getf plist 'y :none) nil))
|
||||
(should (eq (cl-getf plist 'z :none) :none))))
|
||||
(should-not (cl-getf plist 'y :none))
|
||||
(should (eq (cl-getf plist 'z :none) :none))
|
||||
(should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
|
||||
(should (equal plist '(x 3 y nil)))
|
||||
(should-error (cl-incf (cl-getf plist 'y 10) 4) :type 'wrong-type-argument)
|
||||
(should (equal plist '(x 3 y nil)))
|
||||
(should (eq (cl-incf (cl-getf plist 'z 10) 5) 15))
|
||||
(should (equal plist '(z 15 x 3 y nil))))
|
||||
(let ((plist '(x 1 y)))
|
||||
(should (eq (cl-getf plist 'x) 1))
|
||||
(should (eq (cl-getf plist 'y :none) :none))
|
||||
(should (eq (cl-getf plist 'z :none) :none))
|
||||
(should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
|
||||
(should (equal plist '(x 3 y)))
|
||||
(should (eq (cl-incf (cl-getf plist 'y 10) 4) 14))
|
||||
(should (equal plist '(y 14 x 3 y))))
|
||||
(let ((plist '(x 1 y . 2)))
|
||||
(should (eq (cl-getf plist 'x) 1))
|
||||
(should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
|
||||
(should (equal plist '(x 3 y . 2)))
|
||||
(should-error (cl-getf plist 'y :none) :type 'wrong-type-argument)
|
||||
(should-error (cl-getf plist 'z :none) :type 'wrong-type-argument)))
|
||||
|
||||
(ert-deftest cl-extra-test-mapc ()
|
||||
(let ((lst '(a b c))
|
||||
|
|
|
|||
|
|
@ -157,55 +157,42 @@ its getter (Bug#41853)."
|
|||
(push 123 (gv-setter-edebug-get 'gv-setter-edebug
|
||||
'gv-setter-edebug-prop))))
|
||||
(print form (current-buffer)))
|
||||
;; Only check whether evaluation works in general.
|
||||
(eval-buffer)))
|
||||
;; Silence "Edebug: foo" messages.
|
||||
(let ((inhibit-message t))
|
||||
;; Only check whether evaluation works in general.
|
||||
(eval-buffer))))
|
||||
(should (equal (get 'gv-setter-edebug 'gv-setter-edebug-prop) '(123))))
|
||||
|
||||
(ert-deftest gv-plist-get ()
|
||||
(require 'cl-lib)
|
||||
;; Simple `setf' usage for `plist-get'.
|
||||
(let ((target (list :a "a" :b "b" :c "c")))
|
||||
(setf (plist-get target :b) "modify")
|
||||
(should (equal target '(:a "a" :b "modify" :c "c")))
|
||||
(setf (plist-get target ":a" #'string=) "mogrify")
|
||||
(should (equal target '(:a "mogrify" :b "modify" :c "c"))))
|
||||
|
||||
;; Simple setf usage for plist-get.
|
||||
(should (equal (let ((target '(:a "a" :b "b" :c "c")))
|
||||
(setf (plist-get target :b) "modify")
|
||||
target)
|
||||
'(:a "a" :b "modify" :c "c")))
|
||||
;; Other function (`cl-rotatef') usage for `plist-get'.
|
||||
(let ((target (list :a "a" :b "b" :c "c")))
|
||||
(cl-rotatef (plist-get target :b) (plist-get target :c))
|
||||
(should (equal target '(:a "a" :b "c" :c "b")))
|
||||
(cl-rotatef (plist-get target ":a" #'string=)
|
||||
(plist-get target ":b" #'string=))
|
||||
(should (equal target '(:a "c" :b "a" :c "b"))))
|
||||
|
||||
;; Other function (cl-rotatef) usage for plist-get.
|
||||
(should (equal (let ((target '(:a "a" :b "b" :c "c")))
|
||||
(cl-rotatef (plist-get target :b) (plist-get target :c))
|
||||
target)
|
||||
'(:a "a" :b "c" :c "b")))
|
||||
|
||||
;; Add new key value pair at top of list if setf for missing key.
|
||||
(should (equal (let ((target '(:a "a" :b "b" :c "c")))
|
||||
(setf (plist-get target :d) "modify")
|
||||
target)
|
||||
'(:d "modify" :a "a" :b "b" :c "c")))
|
||||
;; Add new key value pair at top of list if `setf' for missing key.
|
||||
(let ((target (list :a "a" :b "b" :c "c")))
|
||||
(setf (plist-get target :d) "modify")
|
||||
(should (equal target '(:d "modify" :a "a" :b "b" :c "c")))
|
||||
(setf (plist-get target :e #'string=) "mogrify")
|
||||
(should (equal target '(:e "mogrify" :d "modify" :a "a" :b "b" :c "c"))))
|
||||
|
||||
;; Rotate with missing value.
|
||||
;; The value corresponding to the missing key is assumed to be nil.
|
||||
(should (equal (let ((target '(:a "a" :b "b" :c "c")))
|
||||
(cl-rotatef (plist-get target :b) (plist-get target :d))
|
||||
target)
|
||||
'(:d "b" :a "a" :b nil :c "c")))
|
||||
|
||||
;; Simple setf usage for plist-get. (symbol plist)
|
||||
(should (equal (let ((target '(a "a" b "b" c "c")))
|
||||
(setf (plist-get target 'b) "modify")
|
||||
target)
|
||||
'(a "a" b "modify" c "c")))
|
||||
|
||||
;; Other function (cl-rotatef) usage for plist-get. (symbol plist)
|
||||
(should (equal (let ((target '(a "a" b "b" c "c")))
|
||||
(cl-rotatef (plist-get target 'b) (plist-get target 'c))
|
||||
target)
|
||||
'(a "a" b "c" c "b"))))
|
||||
|
||||
;; `ert-deftest' messes up macroexpansion when the test file itself is
|
||||
;; compiled (see Bug #24402).
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
(let ((target (list :a "a" :b "b" :c "c")))
|
||||
(cl-rotatef (plist-get target :b) (plist-get target :d))
|
||||
(should (equal target '(:d "b" :a "a" :b nil :c "c")))
|
||||
(cl-rotatef (plist-get target ":e" #'string=)
|
||||
(plist-get target ":d" #'string=))
|
||||
(should (equal target '(":e" "b" :d nil :a "a" :b nil :c "c")))))
|
||||
|
||||
;;; gv-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -29,10 +29,13 @@
|
|||
(require 'ert)
|
||||
(require 'map)
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl-lib))
|
||||
|
||||
(defmacro with-maps-do (var &rest body)
|
||||
"Successively bind VAR to an alist, plist, vector, and hash-table.
|
||||
Each map is built from the following alist data:
|
||||
\\='((0 . 3) (1 . 4) (2 . 5)).
|
||||
((0 . 3) (1 . 4) (2 . 5))
|
||||
Evaluate BODY for each created map."
|
||||
(declare (indent 1) (debug (symbolp body)))
|
||||
(let ((alist (make-symbol "alist"))
|
||||
|
|
@ -84,18 +87,96 @@ Evaluate BODY for each created map."
|
|||
(with-empty-maps-do map
|
||||
(should (= 5 (map-elt map 0 5)))))
|
||||
|
||||
(ert-deftest test-map-elt-testfn ()
|
||||
(ert-deftest test-map-elt-testfn-alist ()
|
||||
"Test the default alist predicate of `map-elt'."
|
||||
(let* ((a (string ?a))
|
||||
(map `((,a . 0) (,(string ?b) . 1))))
|
||||
(should (= (map-elt map a) 0))
|
||||
(should (= (map-elt map "a") 0))
|
||||
(should (= (map-elt map (string ?a)) 0))
|
||||
(should (= (map-elt map "b") 1))
|
||||
(should (= (map-elt map (string ?b)) 1))))
|
||||
(should (= 0 (map-elt map a)))
|
||||
(should (= 0 (map-elt map "a")))
|
||||
(should (= 0 (map-elt map (string ?a))))
|
||||
(should (= 1 (map-elt map "b")))
|
||||
(should (= 1 (map-elt map (string ?b))))
|
||||
(with-suppressed-warnings ((callargs map-elt))
|
||||
(should (= 0 (map-elt map 'a nil #'string=)))
|
||||
(should (= 1 (map-elt map 'b nil #'string=))))))
|
||||
|
||||
(ert-deftest test-map-elt-testfn-plist ()
|
||||
"Test the default plist predicate of `map-elt'."
|
||||
(let* ((a (string ?a))
|
||||
(map `(,a 0 "b" 1)))
|
||||
(should-not (map-elt map "a"))
|
||||
(should-not (map-elt map "b"))
|
||||
(should-not (map-elt map (string ?a)))
|
||||
(should-not (map-elt map (string ?b)))
|
||||
(should (= 0 (map-elt map a)))
|
||||
(with-suppressed-warnings ((callargs map-elt))
|
||||
(should (= 0 (map-elt map a nil #'equal)))
|
||||
(should (= 0 (map-elt map "a" nil #'equal)))
|
||||
(should (= 0 (map-elt map (string ?a) nil #'equal)))
|
||||
(should (= 1 (map-elt map "b" nil #'equal)))
|
||||
(should (= 1 (map-elt map (string ?b) nil #'equal))))))
|
||||
|
||||
(ert-deftest test-map-elt-gv ()
|
||||
"Test the generalized variable `map-elt'."
|
||||
(let ((sort (lambda (map) (sort (map-pairs map) #'car-less-than-car))))
|
||||
(with-empty-maps-do map
|
||||
;; Empty map, without default.
|
||||
(should-error (cl-incf (map-elt map 1)) :type 'wrong-type-argument)
|
||||
(with-suppressed-warnings ((callargs map-elt))
|
||||
(should-error (cl-incf (map-elt map 1.0 nil #'=))
|
||||
:type 'wrong-type-argument))
|
||||
(should (map-empty-p map))
|
||||
;; Empty map, with default.
|
||||
(if (vectorp map)
|
||||
(progn
|
||||
(should-error (cl-incf (map-elt map 1 3)) :type 'args-out-of-range)
|
||||
(with-suppressed-warnings ((callargs map-elt))
|
||||
(should-error (cl-incf (map-elt map 1 3 #'=))
|
||||
:type 'args-out-of-range))
|
||||
(should (map-empty-p map)))
|
||||
(should (= (cl-incf (map-elt map 1 3) 10) 13))
|
||||
(with-suppressed-warnings ((callargs map-elt))
|
||||
(should (= (cl-incf (map-elt map 2.0 5 #'=) 12) 17)))
|
||||
(should (equal (funcall sort map) '((1 . 13) (2.0 . 17))))))
|
||||
(with-maps-do map
|
||||
;; Nonempty map, without predicate.
|
||||
(should (= (cl-incf (map-elt map 1 3) 10) 14))
|
||||
(should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5))))
|
||||
;; Nonempty map, with predicate.
|
||||
(with-suppressed-warnings ((callargs map-elt))
|
||||
(pcase-exhaustive map
|
||||
((pred consp)
|
||||
(should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 17))
|
||||
(should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17))))
|
||||
(should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
|
||||
(should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17)))))
|
||||
((pred vectorp)
|
||||
(should-error (cl-incf (map-elt map 2.0 6 #'=))
|
||||
:type 'wrong-type-argument)
|
||||
(should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5))))
|
||||
(should (= (cl-incf (map-elt map 2 6 #'=) 12) 17))
|
||||
(should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17))))
|
||||
(should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
|
||||
(should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17)))))
|
||||
((pred hash-table-p)
|
||||
(should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 18))
|
||||
(should (member (funcall sort map)
|
||||
'(((0 . 3) (1 . 14) (2 . 5) (2.0 . 18))
|
||||
((0 . 3) (1 . 14) (2.0 . 18) (2 . 5)))))
|
||||
(should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
|
||||
(should (member (funcall sort map)
|
||||
'(((0 . 16) (1 . 14) (2 . 5) (2.0 . 18))
|
||||
((0 . 16) (1 . 14) (2.0 . 18) (2 . 5)))))))))))
|
||||
|
||||
(ert-deftest test-map-elt-with-nil-value ()
|
||||
(should-not (map-elt '((a . 1) (b)) 'b 2)))
|
||||
|
||||
(ert-deftest test-map-elt-signature ()
|
||||
"Test that `map-elt' has the right advertised signature.
|
||||
See bug#58531#25 and bug#58563."
|
||||
(should (equal (get-advertised-calling-convention (symbol-function 'map-elt))
|
||||
'(map key &optional default))))
|
||||
|
||||
(ert-deftest test-map-put! ()
|
||||
(with-maps-do map
|
||||
(setf (map-elt map 2) 'hello)
|
||||
|
|
@ -144,6 +225,24 @@ Evaluate BODY for each created map."
|
|||
(should (equal map '(("a" . 1))))
|
||||
(should-error (map-put! map (string ?a) val #'eq) :type 'map-not-inplace)))
|
||||
|
||||
(ert-deftest test-map-put!-plist ()
|
||||
"Test `map-put!' predicate on plists."
|
||||
(let* ((a (string ?a))
|
||||
(map (list a 0)))
|
||||
(map-put! map a -1)
|
||||
(should (equal map '("a" -1)))
|
||||
(map-put! map 'a 2)
|
||||
(should (equal map '("a" -1 a 2)))
|
||||
(with-suppressed-warnings ((callargs map-put!))
|
||||
(map-put! map 'a -3 #'string=))
|
||||
(should (equal map '("a" -3 a 2)))))
|
||||
|
||||
(ert-deftest test-map-put!-signature ()
|
||||
"Test that `map-put!' has the right advertised signature.
|
||||
See bug#58531#25 and bug#58563."
|
||||
(should (equal (get-advertised-calling-convention (symbol-function 'map-put!))
|
||||
'(map key value))))
|
||||
|
||||
(ert-deftest test-map-put-alist-new-key ()
|
||||
"Regression test for Bug#23105."
|
||||
(let ((alist (list (cons 0 'a))))
|
||||
|
|
@ -395,13 +494,23 @@ Evaluate BODY for each created map."
|
|||
(alist '(("a" . 1) (a . 2))))
|
||||
(should (map-contains-key alist 'a))
|
||||
(should (map-contains-key plist 'a))
|
||||
;; FIXME: Why is no warning emitted for these (bug#58563#13)?
|
||||
(should (map-contains-key alist 'a #'eq))
|
||||
(should (map-contains-key plist 'a #'eq))
|
||||
(should (map-contains-key alist key))
|
||||
(should (map-contains-key alist "a"))
|
||||
(should (map-contains-key plist (string ?a) #'equal))
|
||||
(should-not (map-contains-key plist key))
|
||||
(should-not (map-contains-key alist key #'eq))
|
||||
(should-not (map-contains-key plist key #'eq))))
|
||||
|
||||
(ert-deftest test-map-contains-key-signature ()
|
||||
"Test that `map-contains-key' has the right advertised signature.
|
||||
See bug#58531#25 and bug#58563."
|
||||
(should (equal (get-advertised-calling-convention
|
||||
(symbol-function 'map-contains-key))
|
||||
'(map key))))
|
||||
|
||||
(ert-deftest test-map-some ()
|
||||
(with-maps-do map
|
||||
(should (eq (map-some (lambda (k _v) (and (= k 1) 'found)) map)
|
||||
|
|
@ -515,19 +624,19 @@ Evaluate BODY for each created map."
|
|||
(should (equal alist '((key . value))))))
|
||||
|
||||
(ert-deftest test-map-setf-alist-overwrite-key ()
|
||||
(let ((alist '((key . value1))))
|
||||
(let ((alist (list (cons 'key 'value1))))
|
||||
(should (equal (setf (map-elt alist 'key) 'value2)
|
||||
'value2))
|
||||
(should (equal alist '((key . value2))))))
|
||||
|
||||
(ert-deftest test-map-setf-plist-insert-key ()
|
||||
(let ((plist '(key value)))
|
||||
(let ((plist (list 'key 'value)))
|
||||
(should (equal (setf (map-elt plist 'key2) 'value2)
|
||||
'value2))
|
||||
(should (equal plist '(key value key2 value2)))))
|
||||
|
||||
(ert-deftest test-map-setf-plist-overwrite-key ()
|
||||
(let ((plist '(key value)))
|
||||
(let ((plist (list 'key 'value)))
|
||||
(should (equal (setf (map-elt plist 'key) 'value2)
|
||||
'value2))
|
||||
(should (equal plist '(key value2)))))
|
||||
|
|
@ -535,14 +644,14 @@ Evaluate BODY for each created map."
|
|||
(ert-deftest test-hash-table-setf-insert-key ()
|
||||
(let ((ht (make-hash-table)))
|
||||
(should (equal (setf (map-elt ht 'key) 'value)
|
||||
'value))
|
||||
'value))
|
||||
(should (equal (map-elt ht 'key) 'value))))
|
||||
|
||||
(ert-deftest test-hash-table-setf-overwrite-key ()
|
||||
(let ((ht (make-hash-table)))
|
||||
(puthash 'key 'value1 ht)
|
||||
(should (equal (setf (map-elt ht 'key) 'value2)
|
||||
'value2))
|
||||
'value2))
|
||||
(should (equal (map-elt ht 'key) 'value2))))
|
||||
|
||||
(ert-deftest test-setf-map-with-function ()
|
||||
|
|
@ -551,8 +660,79 @@ Evaluate BODY for each created map."
|
|||
(setf (map-elt map 'foo)
|
||||
(funcall (lambda ()
|
||||
(cl-incf num))))
|
||||
(should (equal map '((foo . 1))))
|
||||
;; Check that the function is only called once.
|
||||
(should (= num 1))))
|
||||
|
||||
(ert-deftest test-map-plist-member ()
|
||||
"Test `map--plist-member' and `map--plist-member-1'."
|
||||
(dolist (mem '(map--plist-member map--plist-member-1))
|
||||
;; Lambda exercises Lisp implementation.
|
||||
(dolist (= `(nil ,(lambda (a b) (eq a b))))
|
||||
(should-not (funcall mem () 'a =))
|
||||
(should-not (funcall mem '(a) 'b =))
|
||||
(should-not (funcall mem '(a 1) 'b =))
|
||||
(should (equal (funcall mem '(a) 'a =) '(a)))
|
||||
(should (equal (funcall mem '(a . 1) 'a =) '(a . 1)))
|
||||
(should (equal (funcall mem '(a 1 . b) 'a =) '(a 1 . b)))
|
||||
(should (equal (funcall mem '(a 1 b) 'a =) '(a 1 b)))
|
||||
(should (equal (funcall mem '(a 1 b) 'b =) '(b)))
|
||||
(should (equal (funcall mem '(a 1 b . 2) 'a =) '(a 1 b . 2)))
|
||||
(should (equal (funcall mem '(a 1 b . 2) 'b =) '(b . 2)))
|
||||
(should (equal (funcall mem '(a 1 b 2) 'a =) '(a 1 b 2)))
|
||||
(should (equal (funcall mem '(a 1 b 2) 'b =) '(b 2)))
|
||||
(should (equal (should-error (funcall mem '(a . 1) 'b =))
|
||||
'(wrong-type-argument plistp (a . 1))))
|
||||
(should (equal (should-error (funcall mem '(a 1 . b) 'b =))
|
||||
'(wrong-type-argument plistp (a 1 . b)))))
|
||||
(should (equal (funcall mem '(a 1 b 2) "a" #'string=) '(a 1 b 2)))
|
||||
(should (equal (funcall mem '(a 1 b 2) "b" #'string=) '(b 2)))))
|
||||
|
||||
(ert-deftest test-map-plist-put ()
|
||||
"Test `map--plist-put' and `map--plist-put-1'."
|
||||
(dolist (put '(map--plist-put map--plist-put-1))
|
||||
;; Lambda exercises Lisp implementation.
|
||||
(dolist (= `(nil ,(lambda (a b) (eq a b))))
|
||||
(let ((l ()))
|
||||
(should (equal (funcall put l 'a 1 =) '(a 1)))
|
||||
(should-not l))
|
||||
(let ((l (list 'a)))
|
||||
(dolist (key '(a b))
|
||||
(should (equal (should-error (funcall put l key 1 =))
|
||||
'(wrong-type-argument plistp (a)))))
|
||||
(should (equal l '(a))))
|
||||
(let ((l (cons 'a 1)))
|
||||
(dolist (key '(a b))
|
||||
(should (equal (should-error (funcall put l key 1 =))
|
||||
'(wrong-type-argument plistp (a . 1)))))
|
||||
(should (equal l '(a . 1))))
|
||||
(let ((l (cons 'a (cons 1 'b))))
|
||||
(should (equal (funcall put l 'a 2 =) '(a 2 . b)))
|
||||
(dolist (key '(b c))
|
||||
(should (equal (should-error (funcall put l key 3 =))
|
||||
'(wrong-type-argument plistp (a 2 . b)))))
|
||||
(should (equal l '(a 2 . b))))
|
||||
(let ((l (list 'a 1 'b)))
|
||||
(should (equal (funcall put l 'a 2 =) '(a 2 b)))
|
||||
(dolist (key '(b c))
|
||||
(should (equal (should-error (funcall put l key 3 =))
|
||||
'(wrong-type-argument plistp (a 2 b)))))
|
||||
(should (equal l '(a 2 b))))
|
||||
(let ((l (cons 'a (cons 1 (cons 'b 2)))))
|
||||
(should (equal (funcall put l 'a 3 =) '(a 3 b . 2)))
|
||||
(dolist (key '(b c))
|
||||
(should (equal (should-error (funcall put l key 4 =))
|
||||
'(wrong-type-argument plistp (a 3 b . 2)))))
|
||||
(should (equal l '(a 3 b . 2))))
|
||||
(let ((l (list 'a 1 'b 2)))
|
||||
(should (equal (funcall put l 'a 3 =) '(a 3 b 2)))
|
||||
(should (equal (funcall put l 'b 4 =) '(a 3 b 4)))
|
||||
(should (equal (funcall put l 'c 5 =) '(a 3 b 4 c 5)))
|
||||
(should (equal l '(a 3 b 4 c 5)))))
|
||||
(let ((l (list 'a 1 'b 2)))
|
||||
(should (equal (funcall put l "a" 3 #'string=) '(a 3 b 2)))
|
||||
(should (equal (funcall put l "b" 4 #'string=) '(a 3 b 4)))
|
||||
(should (equal (funcall put l "c" 5 #'string=) '(a 3 b 4 "c" 5))))))
|
||||
|
||||
(provide 'map-tests)
|
||||
;;; map-tests.el ends here
|
||||
|
|
|
|||
155
test/lisp/net/eudc-tests.el
Normal file
155
test/lisp/net/eudc-tests.el
Normal file
|
|
@ -0,0 +1,155 @@
|
|||
;;; eudc-tests.el --- tests for eudc.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'eudc)
|
||||
|
||||
(ert-deftest eudc--plist-member ()
|
||||
"Test `eudc--plist-member' behavior."
|
||||
(dolist (obj '(a (a . a) (a a . a)))
|
||||
(should-error (eudc--plist-member obj nil) :type 'wrong-type-argument))
|
||||
(dolist (plist '((nil) (a) (a a a)))
|
||||
(dolist (key '(nil a))
|
||||
(should (equal (should-error (eudc--plist-member plist key))
|
||||
'(error "Malformed plist")))))
|
||||
(let ((-nil (string ?n ?i ?l))
|
||||
(-a (string ?a)))
|
||||
(should-not (eudc--plist-member () nil))
|
||||
(should-not (eudc--plist-member () 'a))
|
||||
(should-not (eudc--plist-member '(nil nil) 'a))
|
||||
(should-not (eudc--plist-member '(nil a) 'a))
|
||||
(should-not (eudc--plist-member '(a nil) nil))
|
||||
(should-not (eudc--plist-member '(a a) nil))
|
||||
(should-not (eudc--plist-member '("nil" a) nil))
|
||||
(should-not (eudc--plist-member '("nil" a) -nil))
|
||||
(should-not (eudc--plist-member '("a" a) nil))
|
||||
(should-not (eudc--plist-member '("a" a) -a))
|
||||
(should-not (eudc--plist-member '(nil a nil a) 'a))
|
||||
(should-not (eudc--plist-member '(nil a "a" a) -a))
|
||||
(should (equal (eudc--plist-member '(nil nil) nil) '(nil nil)))
|
||||
(should (equal (eudc--plist-member '(nil a) nil) '(nil a)))
|
||||
(should (equal (eudc--plist-member '(a nil) 'a) '(a nil)))
|
||||
(should (equal (eudc--plist-member '(a a) 'a) '(a a)))
|
||||
(should (equal (eudc--plist-member '(nil nil a nil) 'a) '(a nil)))
|
||||
(should (equal (eudc--plist-member '(nil a a a) 'a) '(a a)))
|
||||
(should (equal (eudc--plist-member '(a a a a) 'a) '(a a a a)))))
|
||||
|
||||
(ert-deftest eudc-plist-member ()
|
||||
"Test `eudc-plist-member' behavior."
|
||||
(dolist (obj '(a (a . a) (a a . a)))
|
||||
(should-error (eudc-plist-member obj nil) :type 'wrong-type-argument))
|
||||
(dolist (plist '((nil) (a) (a a a)))
|
||||
(dolist (key '(nil a))
|
||||
(should (equal (should-error (eudc-plist-member plist key))
|
||||
'(error "Malformed plist")))))
|
||||
(let ((-nil (string ?n ?i ?l))
|
||||
(-a (string ?a)))
|
||||
(should-not (eudc-plist-member () nil))
|
||||
(should-not (eudc-plist-member () 'a))
|
||||
(should-not (eudc-plist-member '(nil nil) 'a))
|
||||
(should-not (eudc-plist-member '(nil a) 'a))
|
||||
(should-not (eudc-plist-member '(a nil) nil))
|
||||
(should-not (eudc-plist-member '(a a) nil))
|
||||
(should-not (eudc-plist-member '("nil" a) nil))
|
||||
(should-not (eudc-plist-member '("nil" a) -nil))
|
||||
(should-not (eudc-plist-member '("a" a) nil))
|
||||
(should-not (eudc-plist-member '("a" a) -a))
|
||||
(should-not (eudc-plist-member '(nil a nil a) 'a))
|
||||
(should-not (eudc-plist-member '(nil a "a" a) -a))
|
||||
(should (eq t (eudc-plist-member '(nil nil) nil)))
|
||||
(should (eq t (eudc-plist-member '(nil a) nil)))
|
||||
(should (eq t (eudc-plist-member '(a nil) 'a)))
|
||||
(should (eq t (eudc-plist-member '(a a) 'a)))
|
||||
(should (eq t (eudc-plist-member '(nil nil a nil) 'a)))
|
||||
(should (eq t (eudc-plist-member '(nil a a a) 'a)))
|
||||
(should (eq t (eudc-plist-member '(a a a a) 'a)))))
|
||||
|
||||
(ert-deftest eudc-plist-get ()
|
||||
"Test `eudc-plist-get' behavior."
|
||||
(dolist (obj '(a (a . a) (a a . a)))
|
||||
(should-error (eudc-plist-get obj nil) :type 'wrong-type-argument))
|
||||
(dolist (plist '((nil) (a) (a a a)))
|
||||
(dolist (key '(nil a))
|
||||
(should (equal (should-error (eudc-plist-get plist key))
|
||||
'(error "Malformed plist")))))
|
||||
(let ((-nil (string ?n ?i ?l))
|
||||
(-a (string ?a)))
|
||||
(should-not (eudc-plist-get () nil))
|
||||
(should-not (eudc-plist-get () 'a))
|
||||
(should-not (eudc-plist-get '(nil nil) nil))
|
||||
(should-not (eudc-plist-get '(nil nil) 'a))
|
||||
(should-not (eudc-plist-get '(nil a) 'a))
|
||||
(should-not (eudc-plist-get '(a nil) nil))
|
||||
(should-not (eudc-plist-get '(a nil) 'a))
|
||||
(should-not (eudc-plist-get '(a a) nil))
|
||||
(should-not (eudc-plist-get '("nil" a) nil))
|
||||
(should-not (eudc-plist-get '("nil" a) -nil))
|
||||
(should-not (eudc-plist-get '("a" a) nil))
|
||||
(should-not (eudc-plist-get '("a" a) -a))
|
||||
(should-not (eudc-plist-get '(nil nil nil a) nil))
|
||||
(should-not (eudc-plist-get '(nil a nil a) 'a))
|
||||
(should-not (eudc-plist-get '(nil a "a" a) -a))
|
||||
(should-not (eudc-plist-get '(a nil a a) 'a))
|
||||
(should (eq 'a (eudc-plist-get '(nil a) nil)))
|
||||
(should (eq 'a (eudc-plist-get '(a a) 'a)))
|
||||
(should (eq 'a (eudc-plist-get '(a a a nil) 'a)))
|
||||
(should (eq 'b (eudc-plist-get () nil 'b)))
|
||||
(should (eq 'b (eudc-plist-get () 'a 'b)))
|
||||
(should (eq 'b (eudc-plist-get '(nil a "a" a) -a 'b)))
|
||||
(should (eq 'b (eudc-plist-get '(a nil "nil" nil) -nil 'b)))))
|
||||
|
||||
(ert-deftest eudc-lax-plist-get ()
|
||||
"Test `eudc-lax-plist-get' behavior."
|
||||
(dolist (obj '(a (a . a) (a a . a)))
|
||||
(should-error (eudc-lax-plist-get obj nil) :type 'wrong-type-argument))
|
||||
(dolist (plist '((nil) (a) (a a a)))
|
||||
(dolist (key '(nil a))
|
||||
(should (equal (should-error (eudc-lax-plist-get plist key))
|
||||
'(error "Malformed plist")))))
|
||||
(let ((-nil (string ?n ?i ?l))
|
||||
(-a (string ?a)))
|
||||
(should-not (eudc-lax-plist-get () nil))
|
||||
(should-not (eudc-lax-plist-get () 'a))
|
||||
(should-not (eudc-lax-plist-get '(nil nil) nil))
|
||||
(should-not (eudc-lax-plist-get '(nil nil) 'a))
|
||||
(should-not (eudc-lax-plist-get '(nil a) 'a))
|
||||
(should-not (eudc-lax-plist-get '(a nil) nil))
|
||||
(should-not (eudc-lax-plist-get '(a nil) 'a))
|
||||
(should-not (eudc-lax-plist-get '(a a) nil))
|
||||
(should-not (eudc-lax-plist-get '("nil" a) nil))
|
||||
(should-not (eudc-lax-plist-get '("nil" a) 'a))
|
||||
(should-not (eudc-lax-plist-get '("a" a) nil))
|
||||
(should-not (eudc-lax-plist-get '("a" a) 'a))
|
||||
(should-not (eudc-lax-plist-get '(nil nil nil a) nil))
|
||||
(should-not (eudc-lax-plist-get '(nil a nil a) 'a))
|
||||
(should-not (eudc-lax-plist-get '(nil a "a" a) 'a))
|
||||
(should-not (eudc-lax-plist-get '(a nil a a) 'a))
|
||||
(should (eq 'a (eudc-lax-plist-get '(nil a) nil)))
|
||||
(should (eq 'a (eudc-lax-plist-get '(a a) 'a)))
|
||||
(should (eq 'a (eudc-lax-plist-get '(a a a nil) 'a)))
|
||||
(should (eq 'b (eudc-lax-plist-get () nil 'b)))
|
||||
(should (eq 'b (eudc-lax-plist-get () 'a 'b)))
|
||||
(should (eq 'a (eudc-lax-plist-get '("nil" a) -nil)))
|
||||
(should (eq 'a (eudc-lax-plist-get '("a" a) -a)))
|
||||
(should (eq 'a (eudc-lax-plist-get '(nil a "a" a) -a)))
|
||||
(should (eq 'b (eudc-lax-plist-get '(nil a "a" a) 'a 'b)))
|
||||
(should (eq 'b (eudc-lax-plist-get '(a nil "nil" nil) nil 'b)))))
|
||||
|
||||
;;; eudc-tests.el ends here
|
||||
|
|
@ -1139,7 +1139,10 @@ final or penultimate step during initialization."))
|
|||
(should-not (plistp '(1 . 2)))
|
||||
(should (plistp '(1 2 3 4)))
|
||||
(should-not (plistp '(1 2 3)))
|
||||
(should-not (plistp '(1 2 3 . 4))))
|
||||
(should-not (plistp '(1 2 3 . 4)))
|
||||
(let ((cycle (list 1 2 3)))
|
||||
(nconc cycle cycle)
|
||||
(should-not (plistp cycle))))
|
||||
|
||||
(defun subr-tests--butlast-ref (list &optional n)
|
||||
"Reference implementation of `butlast'."
|
||||
|
|
|
|||
|
|
@ -857,6 +857,14 @@
|
|||
(should-error (reverse (dot1 1)) :type 'wrong-type-argument)
|
||||
(should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
|
||||
|
||||
(ert-deftest test-cycle-equal ()
|
||||
(should-error (equal (cyc1 1) (cyc1 1)))
|
||||
(should-error (equal (cyc2 1 2) (cyc2 1 2))))
|
||||
|
||||
(ert-deftest test-cycle-nconc ()
|
||||
(should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
|
||||
(should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
|
||||
|
||||
(ert-deftest test-cycle-plist-get ()
|
||||
(let ((c1 (cyc1 1))
|
||||
(c2 (cyc2 1 2))
|
||||
|
|
@ -911,30 +919,47 @@
|
|||
(should-error (plist-put d1 3 3) :type 'wrong-type-argument)
|
||||
(should-error (plist-put d2 3 3) :type 'wrong-type-argument)))
|
||||
|
||||
(ert-deftest test-cycle-equal ()
|
||||
(should-error (equal (cyc1 1) (cyc1 1)))
|
||||
(should-error (equal (cyc2 1 2) (cyc2 1 2))))
|
||||
|
||||
(ert-deftest test-cycle-nconc ()
|
||||
(should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
|
||||
(should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
|
||||
|
||||
(ert-deftest plist-get/odd-number-of-elements ()
|
||||
"Test that `plist-get' doesn't signal an error on degenerate plists."
|
||||
(should-not (plist-get '(:foo 1 :bar) :bar)))
|
||||
|
||||
(ert-deftest plist-put/odd-number-of-elements ()
|
||||
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
|
||||
(should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2)
|
||||
:type 'wrong-type-argument)
|
||||
"Check for bug#27726."
|
||||
(should (equal (should-error (plist-put (list :foo 1 :bar) :zot 2))
|
||||
'(wrong-type-argument plistp (:foo 1 :bar)))))
|
||||
|
||||
(ert-deftest plist-member/improper-list ()
|
||||
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
|
||||
(should (equal (should-error (plist-member '(:foo 1 . :bar) :qux)
|
||||
:type 'wrong-type-argument)
|
||||
"Check for bug#27726."
|
||||
(should (equal (should-error (plist-member '(:foo 1 . :bar) :qux))
|
||||
'(wrong-type-argument plistp (:foo 1 . :bar)))))
|
||||
|
||||
(ert-deftest test-plist ()
|
||||
(let ((plist (list :a "b")))
|
||||
(setq plist (plist-put plist :b "c"))
|
||||
(should (equal (plist-get plist :b) "c"))
|
||||
(should (equal (plist-member plist :b) '(:b "c"))))
|
||||
|
||||
(let ((plist (list "1" "2" "a" "b")))
|
||||
(setq plist (plist-put plist (string ?a) "c"))
|
||||
(should (equal plist '("1" "2" "a" "b" "a" "c")))
|
||||
(should-not (plist-get plist (string ?a)))
|
||||
(should-not (plist-member plist (string ?a))))
|
||||
|
||||
(let ((plist (list "1" "2" "a" "b")))
|
||||
(setq plist (plist-put plist (string ?a) "c" #'equal))
|
||||
(should (equal plist '("1" "2" "a" "c")))
|
||||
(should (equal (plist-get plist (string ?a) #'equal) "c"))
|
||||
(should (equal (plist-member plist (string ?a) #'equal) '("a" "c"))))
|
||||
|
||||
(let ((plist (list :a 1 :b 2 :c 3)))
|
||||
(setq plist (plist-put plist ":a" 4 #'string>))
|
||||
(should (equal plist '(:a 1 :b 4 :c 3)))
|
||||
(should (equal (plist-get plist ":b" #'string>) 3))
|
||||
(should (equal (plist-member plist ":c" #'string<) plist))
|
||||
(dolist (fn '(plist-get plist-member))
|
||||
(should-not (funcall fn plist ":a" #'string<))
|
||||
(should-not (funcall fn plist ":c" #'string>)))))
|
||||
|
||||
(ert-deftest test-string-distance ()
|
||||
"Test `string-distance' behavior."
|
||||
;; ASCII characters are always fine
|
||||
|
|
@ -1350,23 +1375,6 @@
|
|||
(should-error (append loop '(end))
|
||||
:type 'circular-list)))
|
||||
|
||||
(ert-deftest test-plist ()
|
||||
(let ((plist '(:a "b")))
|
||||
(setq plist (plist-put plist :b "c"))
|
||||
(should (equal (plist-get plist :b) "c"))
|
||||
(should (equal (plist-member plist :b) '(:b "c"))))
|
||||
|
||||
(let ((plist '("1" "2" "a" "b")))
|
||||
(setq plist (plist-put plist (copy-sequence "a") "c"))
|
||||
(should-not (equal (plist-get plist (copy-sequence "a")) "c"))
|
||||
(should-not (equal (plist-member plist (copy-sequence "a")) '("a" "c"))))
|
||||
|
||||
(let ((plist '("1" "2" "a" "b")))
|
||||
(setq plist (plist-put plist (copy-sequence "a") "c" #'equal))
|
||||
(should (equal (plist-get plist (copy-sequence "a") #'equal) "c"))
|
||||
(should (equal (plist-member plist (copy-sequence "a") #'equal)
|
||||
'("a" "c")))))
|
||||
|
||||
(ert-deftest fns--string-to-unibyte-multibyte ()
|
||||
(dolist (str (list "" "a" "abc" "a\x00\x7fz" "a\xaa\xbbz" "\x80\xdd\xff"
|
||||
(apply #'unibyte-string (number-sequence 0 255))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue