GNU bug report logs - #74769
[PATCH Cuirass 0/4] Forgejo event support

Previous Next

Package: guix-patches;

Reported by: Romain GARBAGE <romain.garbage <at> inria.fr>

Date: Tue, 10 Dec 2024 16:09:02 UTC

Severity: normal

Tags: patch

Done: Ludovic Courtès <ludovic.courtes <at> inria.fr>

Bug is archived. No further changes may be made.

Full log


Message #8 received at 74769 <at> debbugs.gnu.org (full text, mbox):

From: Romain GARBAGE <romain.garbage <at> inria.fr>
To: 74769 <at> debbugs.gnu.org
Cc: ludovic.courtes <at> inria.fr, Romain GARBAGE <romain.garbage <at> inria.fr>
Subject: [PATCH Cuirass 1/4] tests: Move procedure definition.
Date: Tue, 10 Dec 2024 17:09:25 +0100
* tests/common.scm (specifications-equal?): New variable.
* tests/gitlab.scm (specifications-equal?): Remove variable.
---
 tests/common.scm | 30 +++++++++++++++++++++++++++++-
 tests/gitlab.scm | 24 ------------------------
 2 files changed, 29 insertions(+), 25 deletions(-)

diff --git a/tests/common.scm b/tests/common.scm
index a807498..5054ea0 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -20,7 +20,9 @@
   #:use-module ((cuirass base) #:select (%bridge-socket-file-name))
   #:use-module (cuirass database)
   #:use-module (cuirass parameters)
+  #:use-module (cuirass specification)
   #:use-module (cuirass utils)
+  #:use-module (guix channels)
   #:use-module ((fibers scheduler) #:select (current-scheduler))
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
@@ -28,7 +30,8 @@
             retry
             test-init-db!
             with-guix-daemon
-            wait-for-bridge))
+            wait-for-bridge
+            specifications-equal?))
 
 (define %db
   (make-parameter #f))
@@ -121,3 +124,28 @@ Return the socket on success and #f on failure."
                         (sockaddr:path address)
                         (strerror (system-error-errno args)))
                 #f)))))))
+
+(define (specifications-equal? spec1 spec2)
+  "Return true if SPEC2 and SPEC2 are equivalent, false otherwise."
+  (and (eq? (specification-name spec1)
+            (specification-name spec2))
+       (equal? (specification-build spec1)
+               (specification-build spec2))
+       (= (specification-priority spec1)
+          (specification-priority spec2))
+       (= (specification-period spec1)
+          (specification-period spec2))
+       (equal? (specification-systems spec1)
+               (specification-systems spec2))
+       (equal? (map channel-name
+                    (specification-channels spec1))
+               (map channel-name
+                    (specification-channels spec2)))
+       (equal? (map channel-url
+                    (specification-channels spec1))
+               (map channel-url
+                    (specification-channels spec2)))
+       (equal? (map channel-branch
+                    (specification-channels spec1))
+               (map channel-branch
+                    (specification-channels spec2)))))
diff --git a/tests/gitlab.scm b/tests/gitlab.scm
index ca6cad5..adf94cc 100644
--- a/tests/gitlab.scm
+++ b/tests/gitlab.scm
@@ -157,30 +157,6 @@
     }
   }")
 
-(define (specifications-equal? spec1 spec2)
-  (and (eq? (specification-name spec1)
-            (specification-name spec2))
-       (equal? (specification-build spec1)
-               (specification-build spec2))
-       (= (specification-priority spec1)
-          (specification-priority spec2))
-       (= (specification-period spec1)
-          (specification-period spec2))
-       (equal? (specification-systems spec1)
-               (specification-systems spec2))
-       (equal? (map channel-name
-                    (specification-channels spec1))
-               (map channel-name
-                    (specification-channels spec2)))
-       (equal? (map channel-url
-                    (specification-channels spec1))
-               (map channel-url
-                    (specification-channels spec2)))
-       (equal? (map channel-branch
-                    (specification-channels spec1))
-               (map channel-branch
-                    (specification-channels spec2)))))
-
 (test-assert "default-json"
   (specifications-equal?
    (let ((event (json->gitlab-event default-mr-json)))

base-commit: e96f0887923d4d1cd4e35073fcffdb978d7e1e10
-- 
2.46.0





This bug report was last modified 161 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.