[gnunet-scheme] 02/08: bv-slice: Add procedure for comparing slices.

[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 46ddc3b6864a56df67ea80f085f79babecd68cc5
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Jan 10 14:47:59 2023 +0100

    bv-slice: Add procedure for comparing slices.
    
    * doc/scheme-gnunet.tm: Update copyright line.
    * doc/bytevector-slices.scm (slice-contents-equal?): Document new
    procedure.
    * NEWS: Mention new procedure.
    * gnu/gnunet/utils/bv-slice.scm (slice-contents-equal?):
    New procedure.
    * tests/bv-slice.scm
    ("first argument of slice-contents-equal? must be readable"):
    ("second argument of slice-contents-equal? must be readable"):
    ("slice-contents-equal? is reflexive")
    ("slice-contents-equal? is reflexive (read-only)")
    ("slice-contents-equal? #true backed by same bytevector but different 
offset")
    ("slice-contents-equal? #false backed by same bytevector but different 
offset")
    ("slice-contents-equal? #false backed by same bytevector but different 
length")
    ("slice-contents-equal? #false, same offset and length")
    ("copies are slice-contents-equal?")
    ("copies are slice-contents-equal? (read-only)")
    ("copies are slice-contents-equal? (one offset)"): New tests.
    (make-a-bv): Helper procedure for tests.
---
 NEWS                          |  3 +-
 doc/bytevector-slices.tm      | 14 ++++++++
 doc/scheme-gnunet.tm          |  2 +-
 gnu/gnunet/utils/bv-slice.scm | 21 +++++++++++-
 tests/bv-slice.scm            | 80 ++++++++++++++++++++++++++++++++++++++++++-
 5 files changed, 116 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 550d859..37234f0 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,5 @@
 # -*- mode: org; coding: utf-8 -*-
-# Copyright (C) 2021,2022 GNUnet e.V.
+# Copyright (C) 2021--2023 GNUnet e.V.
 # SPDX-License-Identifier: FSFAP
 # Copying and distribution of this file, with or without modification,
 # are permitted in any medium without royalty provided the copyright
@@ -16,6 +16,7 @@
      read%, select% and 'set%', less tedious when the type and slice remains
      the same.  Also, by using the new macros, the code base should now be a
      bit more readible.
+   - New 'slice-contents-equal?' procedure.
 ** Bugfixes
    - A potential (but unverified) bug with automatic collection is fixed --
      previously, if DHT garbage was found multiple times within a single
diff --git a/doc/bytevector-slices.tm b/doc/bytevector-slices.tm
index 5b1019f..3274ece 100644
--- a/doc/bytevector-slices.tm
+++ b/doc/bytevector-slices.tm
@@ -132,6 +132,20 @@
   </explain|Return <scm|#true> if the slice <var|slice> is writable,
   <scm|#false> otherwise.>
 
+  <\explain>
+    <scm|(slice-contents-equal? <var|this>
+    <var|that>)><index|slice-contents-equal?>
+  <|explain>
+    Return <scm|#true> if the two readable bytevector slices <var|this> and
+    <var|that> have the same contents, i.e., they have the same length and
+    the same octet at each index. If one of the slices is not readable, a
+    <scm|&missing-capabilities> exception is raised, with the
+    \<#2018\>what\<#2019\> field set to the name of the argument as a symbol.
+    If both slices are not readable, it is unspecified whether
+    \<#2018\>what\<#2019\> is \<#2018\>this\<#2019\> or
+    \<#2018\>that\<#2019\>.
+  </explain>
+
   <section|Reading / modifying bytevector slices>
 
   To read the value at a (byte) index in the slice, the procedures
diff --git a/doc/scheme-gnunet.tm b/doc/scheme-gnunet.tm
index 9816852..c791f65 100644
--- a/doc/scheme-gnunet.tm
+++ b/doc/scheme-gnunet.tm
@@ -7,7 +7,7 @@
   manual>|<doc-author|<author-data|<author-name|Maxime
   Devos>|<author-email|maximedevos@telenet.be>>>>
 
-  Copyright \<#A9\> 2012-2016, 2021, 2022 GNUnet e.V.
+  Copyright \<#A9\> 2012-2016, 2021\U2023 GNUnet e.V.
 
   Permission is granted to copy, distribute and/or modify this document under
   the terms of the GNU Free Documentation License, Version 1.3 or any later
diff --git a/gnu/gnunet/utils/bv-slice.scm b/gnu/gnunet/utils/bv-slice.scm
index 72ab94d..edbcf41 100644
--- a/gnu/gnunet/utils/bv-slice.scm
+++ b/gnu/gnunet/utils/bv-slice.scm
@@ -1,6 +1,6 @@
 ;#!r6rs
 ;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
-;;   Copyright (C) 2020, 2021, 2022 GNUnet e.V.
+;;   Copyright (C) 2020--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
@@ -58,6 +58,7 @@
          slice-ieee-double-ref
          slice-ieee-double-set!
          ;; Large operations
+         slice-contents-equal?
          slice-copy!
          slice-zero!
          slice-copy/bytevector
@@ -320,6 +321,24 @@ If not, raise an appropriate @code{&missing-capabilities}."
   
   ;; ‘Large’ operations.
 
+  (define (slice-contents-equal? this that)
+    "Check if the readable bytevector slices @var{this} and @var{that}
+have the same contents.  I.e., the lengths are the same and for all
+valid index, the octets at that index are equal.
+
+The current implementation, as a side-effect, does allocations.
+This is a bug."
+    (verify-slice-readable 'this this)
+    (verify-slice-readable 'that that)
+    ;; fast paths
+    (or (eq? this that)
+       (and (eq? (slice-bv this) (slice-bv that))
+            (= (slice-offset this) (slice-offset that))
+            (= (slice-length this) (slice-length that)))
+       ;; slow path (TODO: replace this with a 'memcmp' equivalent
+       ;; once Guile supports that).
+       (equal? (slice-copy/bytevector this) (slice-copy/bytevector that))))
+
   (define (slice-zero! slice)
     "Zero out the writable slice @var{slice}."
     (verify-slice-writable 'slice slice)
diff --git a/tests/bv-slice.scm b/tests/bv-slice.scm
index 043f6af..a48f7e3 100644
--- a/tests/bv-slice.scm
+++ b/tests/bv-slice.scm
@@ -1,5 +1,5 @@
 ;; This file is part of scheme-GNUnet.
-;; Copyright (C) 2021, 2022 GNUnet e.V.
+;; Copyright (C) 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
@@ -39,6 +39,84 @@
                     (missing-capabilities-required c))))
       code)))
 
+(test-missing-caps
+ "first argument of slice-contents-equal? must be readable"
+ 'this
+ CAP_WRITE
+ CAP_READ
+ (slice-contents-equal? (slice/write-only (make-slice/read-write 9))
+                       (make-slice/read-write 9)))
+
+(test-missing-caps
+ "second argument of slice-contents-equal? must be readable"
+ 'that
+ CAP_WRITE
+ CAP_READ
+ (slice-contents-equal? (make-slice/read-write 9)
+                       (slice/write-only (make-slice/read-write 9))))
+
+(define (make-a-bv n)
+  (define bv (make-bytevector n))
+  (let loop ((i 0))
+    (when (< 0 i n)
+      (bytevector-u8-set! bv i (random 256))))
+  bv)
+
+(test-assert "slice-contents-equal? is reflexive"
+            (let ((s (make-slice/read-write 10)))
+              (slice-contents-equal? s s)))
+
+(test-assert "slice-contents-equal? is reflexive (read-only)"
+            (let ((s (slice/read-only (make-slice/read-write 10))))
+              (slice-contents-equal? s s)))
+
+(test-assert "slice-contents-equal? #true backed by same bytevector but 
different offset"
+            (let* ((s (bv-slice/read-only #vu8(0 1 2 3
+                                               0 1 2 3)))
+                   (s1 (slice/read-only s 0 4))
+                   (s2 (slice/read-only s 4 4)))
+              (and (slice-contents-equal? s1 s2)
+                   (slice-contents-equal? s2 s1))))
+
+(test-assert "slice-contents-equal? #false backed by same bytevector but 
different offset"
+            (let* ((bv (bv-slice/read-only #vu8(0 1 2 3
+                                                0 1 2 4)))
+                   (s1 (slice/read-only bv 0 4))
+                   (s2 (slice/read-only bv 4 4)))
+              (and (not (slice-contents-equal? s1 s2))
+                   (not (slice-contents-equal? s2 s1)))))
+
+(test-assert "slice-contents-equal? #false backed by same bytevector but 
different length"
+            (let* ((s (bv-slice/read-only #vu8(0 1 2 3 4)))
+                   (s1 (slice/read-only s 0 4))
+                   (s2 (slice/read-only s 0 5)))
+              (and (not (slice-contents-equal? s1 s2))
+                   (not (slice-contents-equal? s2 s1)))))
+
+(test-assert "slice-contents-equal? #false, same offset and length"
+            (let ((s1 (bv-slice/read-only #vu8(0 1 2 3)))
+                  (s2 (bv-slice/read-only #vu8(10 11 12 13))))
+              (and (not (slice-contents-equal? s1 s2))
+                   (not (slice-contents-equal? s2 s1)))))
+
+(test-assert
+ "copies are slice-contents-equal?"
+ (let* ((bv (make-a-bv 10))
+       (s (bv-slice/read-write bv)))
+   (slice-contents-equal? s (slice-copy/read-write s))))
+
+(test-assert
+ "copies are slice-contents-equal? (read-only)"
+ (let* ((bv (make-a-bv 10))
+       (s (bv-slice/read-write bv)))
+   (slice-contents-equal? (slice/read-only s) (slice-copy/read-only s))))
+
+(test-assert
+ "copies are slice-contents-equal? (one offset)"
+ (let* ((bv (make-a-bv 10))
+       (s (bv-slice/read-write bv 1)))
+   (slice-contents-equal? s (slice-copy/read-only s))))
+
 (test-missing-caps
  "destination of slice-copy! must be writable"
  'to

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