Merge branch 'master' into gnome-team

2 files changed, 73 insertions, 18 deletions

diff --git a/tests/records.scm b/tests/records.scm
index b1203dfeb7..5464892d3b 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -561,4 +561,58 @@ Description: 1st line,
             (make-fresh-user-module)))
     (lambda (key . args) key)))
 
+(test-equal "match-record, delayed field"
+  "foo bar bar foo"
+  (begin
+    (define-record-type* <with-delayed> with-delayed make-with-delayed
+      with-delayed?
+      (delayed  with-delayed-delayed
+                (delayed)))
+
+    (let ((rec (with-delayed
+                (delayed "foo bar bar foo"))))
+      (match-record rec <with-delayed> (delayed)
+        delayed))))
+
+(test-equal "match-record, thunked field"
+  '("foo" "foobar")
+  (begin
+    (define-record-type* <with-thunked> with-thunked make-with-thunked
+      with-thunked?
+      (normal   with-thunked-normal)
+      (thunked  with-thunked-thunked
+                (thunked)))
+
+    (let ((rec (with-thunked
+                (normal  "foo")
+                (thunked (string-append (with-thunked-normal this-record)
+                                        "bar")))))
+      (match-record rec <with-thunked> (normal thunked)
+        (list normal thunked)))))
+
+(test-equal "match-record, ellipsis in body"
+  #t
+  (begin
+    (define-record-type* <foo> foo make-foo foo?
+      (value foo-value))
+    (define bar (foo (value '(1 2 3))))
+    (match-record bar <foo> (value)
+      (match value
+        ((one two ...)
+         #t)
+        (_
+         #f)))))
+
+(test-equal "match-record-lambda"
+  '("thing: foo" "thing: bar")
+  (begin
+    (define-record-type* <with-text> with-text make-with-text
+      with-text?
+      (text with-text-text))
+
+    (map (match-record-lambda <with-text> (text)
+           (string-append "thing: " text))
+         (list (with-text (text "foo"))
+               (with-text (text "bar"))))))
+
 (test-end)
diff --git a/tests/services.scm b/tests/services.scm
index 8cdb1b2a31..20ff4d317e 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015-2019, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2019, 2022, 2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -287,7 +287,7 @@
          (x x))))
 
 (test-equal "modify-services: do nothing"
-  '(1 2 3)
+  '(1 2 3)                              ;note: service order must be preserved
   (let* ((t1 (service-type (name 't1)
                            (extensions '())
                            (description "")))
@@ -298,12 +298,11 @@
                            (extensions '())
                            (description "")))
          (services (list (service t1 1) (service t2 2) (service t3 3))))
-    (sort (map service-value
-               (modify-services services))
-          <)))
+    (map service-value
+         (modify-services services))))
 
 (test-equal "modify-services: delete service"
-  '(1)
+  '(1 4)                                ;note: service order must be preserved
   (let* ((t1 (service-type (name 't1)
                            (extensions '())
                            (description "")))
@@ -313,12 +312,15 @@
          (t3 (service-type (name 't3)
                            (extensions '())
                            (description "")))
-         (services (list (service t1 1) (service t2 2) (service t3 3))))
-    (sort (map service-value
-               (modify-services services
-                 (delete t3)
-                 (delete t2)))
-          <)))
+         (t4 (service-type (name 't4)
+                           (extensions '())
+                           (description "")))
+         (services (list (service t1 1) (service t2 2)
+                         (service t3 3) (service t4 4))))
+    (map service-value
+         (modify-services services
+           (delete t3)
+           (delete t2)))))
 
 (test-error "modify-services: delete non-existing service"
   #t
@@ -336,7 +338,7 @@
       (delete t3))))
 
 (test-equal "modify-services: change value"
-  '(2 11 33)
+  '(11 2 33)                            ;note: service order must be preserved
   (let* ((t1 (service-type (name 't1)
                            (extensions '())
                            (description "")))
@@ -347,11 +349,10 @@
                            (extensions '())
                            (description "")))
          (services (list (service t1 1) (service t2 2) (service t3 3))))
-    (sort (map service-value
-               (modify-services services
-                 (t1 value => 11)
-                 (t3 value => 33)))
-          <)))
+    (map service-value
+         (modify-services services
+           (t1 value => 11)
+           (t3 value => 33)))))
 
 (test-error "modify-services: change value for non-existing service"
   #t