-(defun ert--cl-do-remf (plist tag)
- "Copy of `cl-do-remf'. Modify PLIST by removing TAG."
- (let ((p (cdr plist)))
- (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
- (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
-
-(defun ert--remprop (sym tag)
- "Copy of `cl-remprop'. Modify SYM's plist by removing TAG."
- (let ((plist (symbol-plist sym)))
- (if (and plist (eq tag (car plist)))
- (progn (setplist sym (cdr (cdr plist))) t)
- (ert--cl-do-remf plist tag))))
-
-(defun ert--remove-if-not (ert-pred ert-list)
- "A reimplementation of `remove-if-not'.
-
-ERT-PRED is a predicate, ERT-LIST is the input list."
- (loop for ert-x in ert-list
- if (funcall ert-pred ert-x)
- collect ert-x))
-
-(defun ert--intersection (a b)
- "A reimplementation of `intersection'. Intersect the sets A and B.
-
-Elements are compared using `eql'."
- (loop for x in a
- if (memql x b)
- collect x))
-
-(defun ert--set-difference (a b)
- "A reimplementation of `set-difference'. Subtract the set B from the set A.
-
-Elements are compared using `eql'."
- (loop for x in a
- unless (memql x b)
- collect x))
-
-(defun ert--set-difference-eq (a b)
- "A reimplementation of `set-difference'. Subtract the set B from the set A.
-
-Elements are compared using `eq'."
- (loop for x in a
- unless (memq x b)
- collect x))
-
-(defun ert--union (a b)
- "A reimplementation of `union'. Compute the union of the sets A and B.
-
-Elements are compared using `eql'."
- (append a (ert--set-difference b a)))
-
-(eval-and-compile
- (defvar ert--gensym-counter 0))
-
-(eval-and-compile
- (defun ert--gensym (&optional prefix)
- "Only allows string PREFIX, not compatible with CL."
- (unless prefix (setq prefix "G"))
- (make-symbol (format "%s%s"
- prefix
- (prog1 ert--gensym-counter
- (incf ert--gensym-counter))))))
-
-(defun ert--coerce-to-vector (x)
- "Coerce X to a vector."
- (when (char-table-p x) (error "Not supported"))
- (if (vectorp x)
- x
- (vconcat x)))
-
-(defun* ert--remove* (x list &key key test)
- "Does not support all the keywords of remove*."
- (unless key (setq key #'identity))
- (unless test (setq test #'eql))
- (loop for y in list
- unless (funcall test x (funcall key y))
- collect y))
-
-(defun ert--string-position (c s)
- "Return the position of the first occurrence of C in S, or nil if none."
- (loop for i from 0
- for x across s
- when (eql x c) return i))
-
-(defun ert--mismatch (a b)
- "Return index of first element that differs between A and B.
-
-Like `mismatch'. Uses `equal' for comparison."
- (cond ((or (listp a) (listp b))
- (ert--mismatch (ert--coerce-to-vector a)
- (ert--coerce-to-vector b)))
- ((> (length a) (length b))
- (ert--mismatch b a))
- (t
- (let ((la (length a))
- (lb (length b)))
- (assert (arrayp a) t)
- (assert (arrayp b) t)
- (assert (<= la lb) t)
- (loop for i below la
- when (not (equal (aref a i) (aref b i))) return i
- finally (return (if (/= la lb)
- la
- (assert (equal a b) t)
- nil)))))))
-
-(defun ert--subseq (seq start &optional end)
- "Return a subsequence of SEQ from START to END."
- (when (char-table-p seq) (error "Not supported"))
- (let ((vector (substring (ert--coerce-to-vector seq) start end)))
- (etypecase seq
- (vector vector)
- (string (concat vector))
- (list (append vector nil))
- (bool-vector (loop with result = (make-bool-vector (length vector) nil)
- for i below (length vector) do
- (setf (aref result i) (aref vector i))
- finally (return result)))
- (char-table (assert nil)))))
-