aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMaxime Devos <maximedevos@telenet.be>2023-01-15 14:23:46 +0100
committerMaxime Devos <maximedevos@telenet.be>2023-01-30 00:17:27 +0100
commit6cc094bc15814353a462b118cf8e203270bd91d0 (patch)
treee33c9750af0b42cc844251b72f945f75188cac39
parent46ddc3b6864a56df67ea80f085f79babecd68cc5 (diff)
downloadgnunet-scheme-6cc094bc15814353a462b118cf8e203270bd91d0.tar.gz
gnunet-scheme-6cc094bc15814353a462b118cf8e203270bd91d0.zip
tests/util: Ignore location of slices.
Will be adjusted later, no news entry yet.
-rw-r--r--tests/utils.scm19
1 files changed, 16 insertions, 3 deletions
diff --git a/tests/utils.scm b/tests/utils.scm
index 09524af..2affc7f 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
1;; This file is part of scheme-GNUnet. 1;; This file is part of scheme-GNUnet.
2;; Copyright © 2021, 2022 GNUnet e.V. 2;; Copyright © 2021--2023 GNUnet e.V.
3;; 3;;
4;; scheme-GNUnet is free software: you can redistribute it and/or modify it 4;; scheme-GNUnet is free software: you can redistribute it and/or modify it
5;; under the terms of the GNU Affero General Public License as published 5;; under the terms of the GNU Affero General Public License as published
@@ -36,7 +36,7 @@
36 (hash->configuration hash-key key=? set-value!) 36 (hash->configuration hash-key key=? set-value!)
37 #:autoload (gnu gnunet mq error-reporting) (error-reporter) 37 #:autoload (gnu gnunet mq error-reporting) (error-reporter)
38 #:autoload (gnu gnunet utils bv-slice) 38 #:autoload (gnu gnunet utils bv-slice)
39 (slice-readable? slice-writable?) 39 (slice? slice-readable? slice-writable? slice-contents-equal?)
40 #:export (conservative-gc? calls-in-tail-position? 40 #:export (conservative-gc? calls-in-tail-position?
41 call-with-services 41 call-with-services
42 call-with-services/fibers 42 call-with-services/fibers
@@ -434,6 +434,19 @@ connection port as seen by the server and can e.g. write to the port or close it
434;; TODO export 434;; TODO export
435(define make-property (@@ (quickcheck property) make-property)) 435(define make-property (@@ (quickcheck property) make-property))
436 436
437;; TODO: eliminate 'normalise' by passing equality procedures.
438(define (equal/ignore-location? this that)
439 (cond ((pair? this)
440 (and (pair? that)
441 (equal/ignore-location? (car this) (car that))
442 (equal/ignore-location? (cdr this) (cdr that))))
443 ((slice? this)
444 (and (slice? that)
445 (eq? (slice-readable? this) (slice-readable? that))
446 (eq? (slice-writable? this) (slice-writable? that))
447 (slice-contents-equal? this that)))
448 (#t (equal? this that))))
449
437(define (round-trip-property analyse construct normalise names gen/arbs) 450(define (round-trip-property analyse construct normalise names gen/arbs)
438 (make-property 451 (make-property
439 names gen/arbs 452 names gen/arbs
@@ -443,7 +456,7 @@ connection port as seen by the server and can e.g. write to the port or close it
443 (! analysed (normalise analysed))) 456 (! analysed (normalise analysed)))
444 (and (slice-readable? constructed) 457 (and (slice-readable? constructed)
445 (slice-writable? constructed) 458 (slice-writable? constructed)
446 (equal? expected analysed)))))) 459 (equal/ignore-location? expected analysed))))))
447 460
448;; This test construct network messages by generating @var{name} ... 461;; This test construct network messages by generating @var{name} ...
449;; with the quickcheck arbitraries @var{$arbitrary} ... 462;; with the quickcheck arbitraries @var{$arbitrary} ...