[gnunet-scheme] 02/04: tests/cadet: Unify analyse+construct tests.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit ba837c74c489ad9649e6732dd86e503f0a61c6fb
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Mar 1 09:46:31 2022 +0000

    tests/cadet: Unify analyse+construct tests.
    
    * tests/cadet.scm (analyse-local-data*): Rename to ...
      (normalise): ... this, and change semantics.
      (test-roundtrip): New macro.
      ("analyse + construct round-trips (local-channel-create)")
      ("analyse + construct round-trips (local-channel-destroy)")
      ("analyse + construct round-trips (local-data)"): Use new macro.
---
 tests/cadet.scm | 68 ++++++++++++++++++++++++++-------------------------------
 1 file changed, 31 insertions(+), 37 deletions(-)

diff --git a/tests/cadet.scm b/tests/cadet.scm
index 3bbaf1e..c0e6b79 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -19,6 +19,7 @@
 (import (gnu gnunet cadet client)
        (gnu gnunet cadet network)
        (gnu gnunet utils bv-slice)
+       (gnu gnunet utils hat-let)
        (gnu gnunet netstruct syntactic)
        (gnu gnunet crypto struct)
        (gnu gnunet hashcode struct)
@@ -120,43 +121,36 @@
 ;; Actual sizes can be a lot larger
 (define $cadet-data ($sized-bytevector-slice/read-only 500))
 
-(test-assert "analyse + construct round-trips (local-channel-create)"
-  (quickcheck
-   (property ((channel-number $channel-number)
-             (cadet-address $cadet-address)
-             (options $options))
-            (receive (cadet-address* channel-number* options*)
-                (analyse-local-channel-create
-                 (construct-local-channel-create
-                  cadet-address channel-number  options))
-              (and (equal? channel-number channel-number*)
-                   (equal? cadet-address cadet-address*)
-                   (equal? options options*))))))
-
-(test-assert "analyse + construct round-trips (local-channel-destroy)"
-  (quickcheck
-   (property ((channel-number $channel-number))
-            (equal? channel-number
-                    (analyse-local-channel-destroy
-                     (construct-local-channel-destroy channel-number))))))
-
-(define (analyse-local-data* . foo)
-  (define (fix . stuff)
-    (map (match-lambda
-          ((? slice? s) (slice-copy/read-only s))
-          (foo foo))
-        stuff))
-  (call-with-values (lambda () (apply analyse-local-data foo)) fix))
-
-(test-assert "analyse + construct round-trips (local-data)"
-  (quickcheck
-   (property ((channel-number $channel-number)
-             (priority-preference $priority-preference)
-             (data $cadet-data))
-            (equal? (list channel-number priority-preference data)
-                    (analyse-local-data*
-                     (construct-local-data
-                      channel-number priority-preference data))))))
+(define (normalise list)
+  (map (match-lambda
+        ((? slice? s) (slice-copy/read-only s))
+        (foo foo))
+       list))
+
+(define-syntax-rule
+  (test-roundtrip testcase analyse construct (name $arbitrary) ...)
+  (test-assert testcase
+    (quickcheck
+     (property ((name $arbitrary) ...)
+              (let^ ((! expected (pk 'e (list name ...)))
+                     (! constructed (construct name ...))
+                     (<-- analysed (analyse constructed))
+                     (! analysed (normalise analysed)))
+                    (equal? expected analysed))))))
+
+(test-roundtrip "analyse + construct round-trips (local-channel-create)"
+               analyse-local-channel-create construct-local-channel-create
+               (cadet-address $cadet-address)
+               (channel-number $channel-number)
+               (options $options))
+(test-roundtrip "analyse + construct round-trips (local-channel-destroy)"
+               analyse-local-channel-destroy construct-local-channel-destroy
+               (channel-number $channel-number))
+(test-roundtrip "analyse + construct round-trips (local-data)"
+               analyse-local-data construct-local-data
+               (channel-number $channel-number)
+               (priority-preference $priority-preference)
+               (data $cadet-data))
 
 ;; header information will be tested elsewhere (TODO)
 

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.