From cf2913fdea405ee0da9a6dbf76fdcc91cbd324dc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Tue, 11 Apr 2023 13:58:59 +0200
Subject: [PATCH] Fix member record tests.

---
 src/member-record.scm  | 73 +++++++++++++++++++++++++++---------------
 src/util-dict-list.scm | 24 +++++++++++---
 2 files changed, 66 insertions(+), 31 deletions(-)

diff --git a/src/member-record.scm b/src/member-record.scm
index bb32946..9bcdc8b 100644
--- a/src/member-record.scm
+++ b/src/member-record.scm
@@ -352,50 +352,71 @@
  (define (member-record-tests!)
    (run-tests
     member-record
-    (test-equal? make-member-record
-		 (make-member-record '|1234| "members/1234" '(|member|))
-		 (make-ldict
-		  '((file-name . |1234|)
+    (test-true make-member-record
+	       (ldict-equal?
+		(make-member-record '|1234| "members/1234" '(|member|))
+		(make-ldict
+		 '((file-name . |1234|)
 		   (file-path . "members/1234")
 		   (symlinks |member|)
-		   (id . 1234))))
-    (test-equal? make-member-record
-		 (make-member-record '|1234| "members/1234" '(|member|) #:msg "msg")
+		   (id . 1234)))))
+    (test-true make-member-record
+	       (ldict-equal?
+		(make-member-record '|1234| "members/1234" '(|member|) #:msg "msg")
+		(make-ldict
 		 '((msg . "msg")
 		   (file-name . |1234|)
 		   (file-path . "members/1234")
 		   (symlinks |member|)
-		   (id . 1234)))
-    (test-equal? member-record-set
-		 (member-record-set '() #:id 1234)
-		 '((id . 1234)))
-    (test-equal? member-record-add-highlight
-		 (member-record-add-highlight '() 123 "Interesting..." 0 'info)
-		 '((highlights . ((123 "Interesting..." 0 info)))))
+		   (id . 1234)))))
+    (test-true member-record-set
+	       (ldict-equal?
+		(member-record-set (make-ldict) #:id 1234)
+		(make-ldict
+		 '((id . 1234)))))
+    (test-true member-record-add-highlight
+	       (ldict-equal?
+		(member-record-add-highlight (make-ldict) 123 "Interesting..." 0 'info)
+		(make-ldict
+		 '((highlights . ((123 "Interesting..." 0 info)))))))
     (test-true member-destroyed?
 	       (parameterize ((*current-month* (list 2023 2)))
-		 (member-destroyed? '((info . ((member . (((2010 1) (2010 5))))))))))
+		 (member-destroyed?
+		  (make-ldict `((info . ,(make-ldict
+					  `((member . (((2010 1) (2010 5))))))))))))
     (test-false member-destroyed?
 		(parameterize ((*current-month* (list 2009 2)))
-		  (member-destroyed? '((info . ((member . (((2001 1) (2010 5))))))))))
+		  (member-destroyed?
+		   (make-ldict `((info . ,(make-ldict
+					   `((member . (((2001 1) (2010 5))))))))))))
     (test-false member-suspended?
-		(member-suspended? '((info . ((member . (((2015 1) #f))))))))
+		(member-suspended?
+		 (make-ldict `((info . ,(make-ldict
+					 `((member . (((2015 1) #f))))))))))
     (test-true member-suspended?
 	       (parameterize ((*current-month* (list 2015 2)))
-		 (member-suspended? '((info . ((member . (((2015 1) #f)))
-					       (suspend ((2010 1) (2022 4) #f #f))))))))
+		 (member-suspended?
+		  (make-ldict `((info . ,(make-ldict
+					  `((member . (((2015 1) #f)))
+					    (suspend ((2010 1) (2022 4) #f #f))))))))))
     (test-true member-suspended?
 	       (parameterize ((*current-month* (list 2015 2)))
-		 (member-suspended? '((info . ((member . (((2015 1) #f)))
-					       (suspend ((2010 1) #f #f #f))))))))
+		 (member-suspended?
+		  (make-ldict `((info . ,(make-ldict
+					  `((member . (((2015 1) #f)))
+					    (suspend ((2010 1) #f #f #f))))))))))
     (test-false member-suspended?
 		(parameterize ((*current-month* (list 2023 2)))
-		  (member-suspended? '((info . ((member . (((2015 1) #f)))
-						(suspend ((2010 1) (2022 4) #f #f))))))))
+		  (member-suspended?
+		   (make-ldict `((info . ,(make-ldict
+					   `((member . (((2015 1) #f)))
+					     (suspend ((2010 1) (2022 4) #f #f))))))))))
     (test-true member-active?
-		(parameterize ((*current-month* (list 2023 2)))
-		  (member-active? '((info . ((member . (((2015 1) #f)))
-					     (suspend ((2010 1) (2022 4) #f #f))))))))
+	       (parameterize ((*current-month* (list 2023 2)))
+		 (member-active?
+		  (make-ldict `((info . ,(make-ldict
+					  `((member . (((2015 1) #f)))
+					    (suspend ((2010 1) (2022 4) #f #f))))))))))
     ))
 
  )
diff --git a/src/util-dict-list.scm b/src/util-dict-list.scm
index 01f1ce7..dbcf7df 100644
--- a/src/util-dict-list.scm
+++ b/src/util-dict-list.scm
@@ -213,11 +213,25 @@
 
  ;; Returns true if both dictionaries contain the same keys and
  ;; values.
- (define (ldict-equal? d1 d2)
-   (let ((k1 (list->lset (ldict-keys d1)))
-	 (k2 (list->lset (ldict-keys d2))))
-     ;; Compare key sets
-     #f))
+ (define (ldict-equal? d1 d2 . equality?)
+   (let ((e1 (ldict-equality? d1))
+	 (e2 (ldict-equality? d2)))
+     (let ((equality? (if (null? equality?)
+			  equal?
+			  (car equality?))))
+       (if (not (eq? e1 e2))
+	   #f
+	   (let ((k1 (list->lset (ldict-keys d1)))
+		 (k2 (list->lset (ldict-keys d2))))
+	     (if (lset=? k1 k2)
+		 (let loop ((keys (lset->list k1)))
+		   (if (null? keys)
+		       #t
+		       (if (equality? (ldict-ref d1 (car keys))
+				      (ldict-ref d2 (car keys)))
+			   (loop (cdr keys))
+			   #f)))
+		 #f))))))
 
  ;; Performs self-tests of the dictionary module.
  (define (ldict-tests!)