branch: externals/hyperbole
commit d6e9341ffd5d00ac727c4b6493903a6c39edacea
Author: Mats Lidell <mats.lid...@lidells.se>
Commit: GitHub <nore...@github.com>
Add tests for Hyperbole set library (#302)
---
ChangeLog | 2 ++
set.el | 18 +++---------------
test/set-tests.el | 40 +++++++++++++++++++++++-----------------
3 files changed, 28 insertions(+), 32 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 4b5334fc95..1e7f92c01c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
2023-02-06 Mats Lidell <ma...@gnu.org>
+* test/set-tests.el: Add tests for Hyperbole set library.
+
* hui-mini.el (hui:menu-choose): Use hui:menu-exit-hyperbole
* hsys-org.el (hsys-org-search-internal-link-p):
diff --git a/set.el b/set.el
index aa9962cb4d..954cd21774 100644
--- a/set.el
+++ b/set.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 26-Sep-91 at 19:24:19
-;; Last-Mod: 6-Feb-23 at 01:57:00 by Bob Weiner
+;; Last-Mod: 6-Feb-23 at 20:05:30 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -186,13 +186,7 @@ Return the set. Use (setq set (set:replace elt set)) to
assure set is
always properly modified.
Use `set:equal-op' for element comparisons."
- (let ((elt-set (set:member old-elt set)))
- (if elt-set
- ;; replace element
- (progn (setcar elt-set new-elt)
- set)
- ;; add new element
- (cons new-elt set))))
+ (set:add new-elt (set:remove old-elt set)))
(defun set:replace-key-value (key value set)
"Replace or add element whose car matches KEY with a cdr of VALUE in SET.
@@ -201,13 +195,7 @@ always properly modified.
Use `set:equal-op' to match against KEY. Assume each element in the set has a
car and a cdr."
- (let ((elt-set (set:member key set)))
- (if elt-set
- ;; replace element
- (progn (setcar elt-set (cons key value))
- set)
- ;; add new element
- (cons (cons key value) set))))
+ (set:add (cons key value) (set:remove-key-value key set)))
(defun set:subset (sub set)
"Return t iff set SUB is a subset of SET.
diff --git a/test/set-tests.el b/test/set-tests.el
index 7cb920772a..096298e2b8 100644
--- a/test/set-tests.el
+++ b/test/set-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell
;;
;; Orig-Date: 5-Feb-23 at 09:12:52
-;; Last-Mod: 6-Feb-23 at 02:06:27 by Bob Weiner
+;; Last-Mod: 6-Feb-23 at 21:33:27 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -18,7 +18,7 @@
(require 'set)
-(ert-deftest set-tests--function-tests ()
+(ert-deftest set-tests--function-tests-equal ()
"Test Hyperbole set library functions."
(should (set:equal (set:create) nil))
(should (set:empty (set:create)))
@@ -51,6 +51,10 @@
(should (set:equal (set:combinations (set:create 'a 'b 'c))
'(nil a b c (a b) (a c) (b c) (a b c))))
+ (should (set:equal (set:combinations (set:create 'a 'b 'c) 1) (set:create 'a
'b 'c)))
+ (should (set:equal (set:combinations (set:create 'a 'b 'c) 2) (set:create
'(a b) '(b c) '(a c))))
+ (should (set:equal (set:combinations (set:create 'a 'b 'c) 3) (set:create
'(a b c))))
+
(should (set:empty (set:intersection (set:create) (set:create))))
(should (set:empty (set:intersection (set:create) (set:create 'a))))
(should (set:empty (set:intersection (set:create 'a) (set:create 'c))))
@@ -100,37 +104,39 @@
(should (set:equal (set:add 'a (set:create)) (set:create 'a)))
(should (set:equal (set:add 'a (set:create 'a)) (set:create 'a)))
;; Adding a list as an element in a set
- (should (set:equal (set:add '(b c) (set:create 'a)) (set:create 'a '(b c))))
+ (should (set:equal (set:add '(b c) (set:create 'a)) (set:create '(b c) 'a)))
(should (set:empty (set:remove 'a (set:create 'a))))
(should (set:equal (set:remove 'a (set:create 'b)) (set:create 'b)))
(should (set:equal (set:remove 'a (set:create 'a 'b)) (set:create 'b)))
(should-not (set:equal (set:remove 'a (set:create 'a 'b)) (set:create 'a
'b)))
- ;; FIXME: Need to add tests for (set:remove-key-value key set)
+ (should (set:empty (set:remove-key-value 'a (set:create (cons 'a
'value-a)))))
+ (should (set:equal (set:remove-key-value 'b (set:create (cons 'a 'value-a)))
+ (set:create (cons 'a 'value-a))))
+ (should (set:equal (set:remove-key-value 'b (set:create (cons 'a 'value-a)
(cons 'b 'value-b)))
+ (set:create (cons 'a 'value-a))))
;; set:get - requires elements to be of type (key . value)
(should (equal (set:get 'a (set:create (cons 'a 'value-a))) 'value-a))
(should (equal (set:get 'b (set:create (cons 'a 'value-a))) nil))
- ;; FIXME: Need to add tests for (set:replace old-val new-val set)
+ (should (set:equal (set:replace 'a 'c (set:create 'a)) (set:create 'c)))
+ (should (set:equal (set:replace 'a 'c (set:create)) (set:create 'c)))
+ (should (set:equal (set:replace 'b 'c (set:create 'a 'b)) (set:create 'a
'c)))
;; set:replace-key-value - requires elements to be of type (key . value)
(should (set:equal (set:replace-key-value 'a 'new-value-a (set:create (cons
'a 'value-a)))
- (set:create '(a . new-value-a) '(a . value-a))))
+ (set:create '(a . new-value-a))))
(should (set:equal (set:replace-key-value 'b 'new-value-b (set:create (cons
'a 'value-a)))
(set:create '(b . new-value-b) '(a . value-a))))
- (let ((set (set:create (cons 'a 'value-a))))
- (setq set (set:replace-key-value 'a 'new-value-a set))
- (should (set:equal set (set:create '(a . new-value-a) '(a . value-a)))))
-
- ;; set:members works on lists!?
- ;; FIXME: Use verification that list contains elements rather than checking
- ;; a specific order
- (should (equal (set:members '(1)) '(1)))
- (should (equal (set:members '(1 2)) '(1 2)))
- (should (equal (set:members '(1 1)) '(1)))
- (should (equal (set:members '(1 1 2 2)) '(1 2))))
+ (should (set:equal (set:replace-key-value 'b 'new-value-b (set:create (cons
'a 'value-a) (cons 'b 'value-b)))
+ (set:create '(b . new-value-b) '(a . value-a))))
+
+ (should (set:equal (set:members '(1)) '(1)))
+ (should (set:equal (set:members '(1 2)) '(1 2)))
+ (should (set:equal (set:members '(1 1)) '(1)))
+ (should (set:equal (set:members '(1 1 2 2)) '(1 2))))
(ert-deftest set-tests--equal-op-tests ()
"Test Hyperbole set library functions with equal op always true."
