From 6cc094bc15814353a462b118cf8e203270bd91d0 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 15 Jan 2023 14:23:46 +0100 Subject: tests/util: Ignore location of slices. Will be adjusted later, no news entry yet. --- tests/utils.scm | 19 ++++++++++++++++--- 1 file 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 @@ ;; This file is part of scheme-GNUnet. -;; Copyright © 2021, 2022 GNUnet e.V. +;; Copyright © 2021--2023 GNUnet e.V. ;; ;; scheme-GNUnet is free software: you can redistribute it and/or modify it ;; under the terms of the GNU Affero General Public License as published @@ -36,7 +36,7 @@ (hash->configuration hash-key key=? set-value!) #:autoload (gnu gnunet mq error-reporting) (error-reporter) #:autoload (gnu gnunet utils bv-slice) - (slice-readable? slice-writable?) + (slice? slice-readable? slice-writable? slice-contents-equal?) #:export (conservative-gc? calls-in-tail-position? call-with-services 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 ;; TODO export (define make-property (@@ (quickcheck property) make-property)) +;; TODO: eliminate 'normalise' by passing equality procedures. +(define (equal/ignore-location? this that) + (cond ((pair? this) + (and (pair? that) + (equal/ignore-location? (car this) (car that)) + (equal/ignore-location? (cdr this) (cdr that)))) + ((slice? this) + (and (slice? that) + (eq? (slice-readable? this) (slice-readable? that)) + (eq? (slice-writable? this) (slice-writable? that)) + (slice-contents-equal? this that))) + (#t (equal? this that)))) + (define (round-trip-property analyse construct normalise names gen/arbs) (make-property 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 (! analysed (normalise analysed))) (and (slice-readable? constructed) (slice-writable? constructed) - (equal? expected analysed)))))) + (equal/ignore-location? expected analysed)))))) ;; This test construct network messages by generating @var{name} ... ;; with the quickcheck arbitraries @var{$arbitrary} ... -- cgit v1.2.3