[gnunet-scheme] 01/03: utils/bv-slice: Define copying procedures.

[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 39ce0bf3c3bd3ae76f35643d8aed31c6d27ca28d
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Feb 21 20:00:40 2022 +0000

    utils/bv-slice: Define copying procedures.
    
    * gnu/gnunet/utils/bv-slice.scm
      (slice-copy/read-write,slice-copy/read-only): New procedures.
    * gnu/gnunet/dht/client.scm
      (slice-copy): Remove.
      (copy-datum,copy-query,copy-search-result): Use new procedures.
    * tests/bv-slice.scm (slice-independent?): New procedure.
      ("source of slice-copy/read-write must be readable")
      ("even if the length is zero")
      ("return value of slice-copy/read-write is read-write")
      ("return value of slice-copy/read-write is read-write, even if length is 
zero")
      ("return value of slice-copy/read-write independent of original")
      ("return value of slice-copy/read-write is fresh even if length is zero")
      ("slice-copy/read-write returns something with the same contents (1)")
      ("slice-copy/read-write returns something with the same contents (2)")
      ("source of slice-copy/read-only must be readable")
      ("even if the size is zero")
      ("return value of slice-copy/read-only is read-only")
      ("return value of slice-copy/read-only is read-only, even if length is 
zero")
      ("return value of slice-copy/read-only independent of original")
      ("return value of slice-copy/read-only is fresh even if length is zero 
(1)")
      ("return value of slice-copy/read-only is fresh even if length is zero 
(2)")
      ("slice-copy/read-only returns something with the same contents (1)")
      ("slice-copy/read-only returns something with the same
      contents (2)"): New tests.
---
 gnu/gnunet/dht/client.scm     | 21 ++++------
 gnu/gnunet/utils/bv-slice.scm | 19 ++++++++-
 tests/bv-slice.scm            | 96 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 123 insertions(+), 13 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 6b4f74c..db999fb 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -110,7 +110,8 @@
                read% sizeof set%! select)
          (only (gnu gnunet utils bv-slice)
                slice-length slice/read-only make-slice/read-write slice-copy!
-               slice-slice verify-slice-readable)
+               slice-slice verify-slice-readable slice-copy/read-write
+               slice-copy/read-only)
          (gnu gnunet utils hat-let)
          (only (gnu gnunet utils cut-syntax)
                cut-syntax)
@@ -246,18 +247,12 @@ If this bound is exceeded, an appropriate 
@code{&overly-large-datum} and
                  (slice/read-only value)
                  expiration))))) ; TODO validate expiration
 
-    ;; XXX deduplicate
-    (define (slice-copy slice)
-      (define new (make-slice/read-write (slice-length slice)))
-      (slice-copy! slice new)
-      new)
-
     (define (copy-datum old)
       "Make a copy of the datum @var{old}, such that modifications to the
 slices in @var{old} do not impact the new datum."
       (make-datum (datum-type old)
-                 (slice-copy (datum-key old))
-                 (slice-copy (datum-value old))
+                 (slice-copy/read-only (datum-key old))
+                 (slice-copy/read-only (datum-value old))
                  #:expiration (datum-expiration old)))
 
     ;; A request to insert something in the DHT.
@@ -309,7 +304,7 @@ query object with the predicate @code{query?}."
       "Make a copy of the query object @var{old}, such that modifications to 
the
 slices in @var{old} do not impact the new query object."
       (make-query (query-type old)
-                 (slice-copy (query-key old))
+                 (slice-copy/read-only (query-key old))
                  #:desired-replication-level
                  (query-desired-replication-level old)))
 
@@ -395,8 +390,10 @@ slices in @var{old} do not impact the new search result."
       (define get-path (search-result-get-path old))
       (define put-path (search-result-put-path old))
       (datum->search-result (copy-datum (search-result->datum old))
-                           #:get-path (and get-path (slice-copy get-path))
-                           #:put-path (and put-path (slice-copy put-path))))
+                           #:get-path
+                           (and get-path (slice-copy/read-only get-path))
+                           #:put-path
+                           (and put-path (slice-copy/read-only put-path))))
 
     
 
diff --git a/gnu/gnunet/utils/bv-slice.scm b/gnu/gnunet/utils/bv-slice.scm
index 550ddff..c8206a7 100644
--- a/gnu/gnunet/utils/bv-slice.scm
+++ b/gnu/gnunet/utils/bv-slice.scm
@@ -59,6 +59,8 @@
          ;; Large operations
          slice-copy!
          slice-zero!
+         slice-copy/read-write
+         slice-copy/read-only
 
          ;; Exceptions
          &missing-capabilities
@@ -331,4 +333,19 @@ the writable slice @var{slice}.  The slices may overlap."
     (bytevector-copy! (slice-bv from) (slice-offset from)
                      (slice-bv to) (slice-offset to)
                      (slice-length from))
-    (values)))
+    (values))
+
+  (define (slice-copy/read-write original)
+    "Return a fresh read-write slice with the same contents as @var{original}.
+Future modifications to @var{original} will not impact the returned slice.
+The slice @var{original} must be readable."
+    (verify-slice-readable 'original original)
+    (define new (make-slice/read-write (slice-length original)))
+    (slice-copy! original new)
+    new)
+
+  (define (slice-copy/read-only original)
+    "Return a fresh read-only slice with the same contents as @var{original}.
+Future modifications to @var{original} will not impact the returned slice.
+THe slice @var{originall} must be readable."
+    (slice/read-only (slice-copy/read-write original))))
diff --git a/tests/bv-slice.scm b/tests/bv-slice.scm
index de97c92..620373b 100644
--- a/tests/bv-slice.scm
+++ b/tests/bv-slice.scm
@@ -176,6 +176,102 @@
   (object->string
    (slice/write-only (bv-slice/read-write #vu8(1 2 3)))))
 
+(define (slice-independent? x y)
+  (not (eq? (slice-bv x) (slice-bv y))))
+
+(test-missing-caps
+ "source of slice-copy/read-write must be readable"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-write (slice/write-only (make-slice/read-write 9))))
+
+(test-missing-caps
+ "even if the length is zero"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-write (slice/write-only (make-slice/read-write 0))))
+
+(test-assert "return value of slice-copy/read-write is read-write"
+  (let ((copy (slice-copy/read-write (make-slice/read-write 9))))
+    (and (slice-readable? copy) (slice-writable? copy))))
+(test-assert "return value of slice-copy/read-write is read-write, even if 
length is zero"
+  (let ((copy (slice-copy/read-write (make-slice/read-write 0))))
+    (and (slice-readable? copy) (slice-writable? copy))))
+
+(test-assert "return value of slice-copy/read-write independent of original"
+  (let* ((original (make-slice/read-write 9))
+        (copy (slice-copy/read-write original)))
+    (slice-independent? original copy)))
+(test-assert "return value of slice-copy/read-write is fresh even if length is 
zero"
+  (let* ((original (make-slice/read-write 0))
+        (copy (slice-copy/read-write original)))
+    (not (eq? original copy))))
+(test-equal "slice-copy/read-write returns something with the same contents 
(1)"
+  #vu8(10 9 8 7 6 5)
+  (let* ((original (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6))
+        (copy (slice-copy/read-write original))
+        (bv (make-bytevector 6)))
+    (slice-copy! copy (bv-slice/read-write bv))
+    bv))
+(test-equal "slice-copy/read-write returns something with the same contents 
(2)"
+  #vu8(10 9 8 7 6 5)
+  (let* ((original (slice/read-only
+                   (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6)))
+        (copy (slice-copy/read-write original))
+        (bv (make-bytevector 6)))
+    (slice-copy! copy (bv-slice/read-write bv))
+    bv))
+
+(test-missing-caps
+ "source of slice-copy/read-only must be readable"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-only (slice/write-only (make-slice/read-write 9))))
+
+(test-missing-caps
+ "even if the size is zero"
+ 'original
+ CAP_WRITE
+ CAP_READ
+ (slice-copy/read-only (slice/write-only (make-slice/read-write 0))))
+
+(test-assert "return value of slice-copy/read-only is read-only"
+  (let ((copy (slice-copy/read-only (make-slice/read-write 9))))
+    (and (slice-readable? copy) (not (slice-writable? copy)))))
+(test-assert "return value of slice-copy/read-only is read-only, even if 
length is zero"
+  (let ((copy (slice-copy/read-only (make-slice/read-write 0))))
+    (and (slice-readable? copy) (not (slice-writable? copy)))))
+(test-assert "return value of slice-copy/read-only independent of original"
+  (let* ((original (make-slice/read-write 9))
+        (copy (slice-copy/read-only original)))
+    (slice-independent? original copy)))
+(test-assert "return value of slice-copy/read-only is fresh even if length is 
zero (1)"
+  (let* ((original (make-slice/read-write 0))
+        (copy (slice-copy/read-only original)))
+    (not (eq? original copy))))
+(test-assert "return value of slice-copy/read-only is fresh even if length is 
zero (2)"
+  (let* ((original (slice/read-only (make-slice/read-write 0)))
+        (copy (slice-copy/read-only original)))
+    (not (eq? original copy))))
+(test-equal "slice-copy/read-only returns something with the same contents (1)"
+  #vu8(10 9 8 7 6 5)
+  (let* ((original (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6))
+        (copy (slice-copy/read-only original))
+        (bv (make-bytevector 6)))
+    (slice-copy! copy (bv-slice/read-write bv))
+    bv))
+(test-equal "slice-copy/read-only returns something with the same contents (2)"
+  #vu8(10 9 8 7 6 5)
+  (let* ((original (slice/read-only
+                   (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6)))
+        (copy (slice-copy/read-only original))
+        (bv (make-bytevector 6)))
+    (slice-copy! copy (bv-slice/read-write bv))
+    bv))
+
 (test-end "bv-slice")
 
 ;; ^ TODO: test other procedures

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