[gnunet-scheme] branch master updated (b7a8906 -> 46488d3)

[gnunet]

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

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

    from b7a8906  dht/client: Improve and test <datum> records.
     new f130202  tests/distributed-hash-table: Test 'copy-datum'.
     new 152feee  dht/client: Copy the datum in 'copy-search-result' (bugfix).
     new dd80a1d  tests/distributed-hash-table: Test 'copy-search-result'.
     new 46488d3  doc/scheme-gnunet: Remove obsolete warning.

The 4 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "add" were already present in the repository and have only
been added to this reference.


Summary of changes:
 doc/scheme-gnunet.tm             |  4 ---
 gnu/gnunet/dht/client.scm        |  2 +-
 tests/distributed-hash-table.scm | 73 ++++++++++++++++++++++++++++++++++++++--
 3 files changed, 72 insertions(+), 7 deletions(-)

diff --git a/doc/scheme-gnunet.tm b/doc/scheme-gnunet.tm
index 6c3619b..f242adf 100644
--- a/doc/scheme-gnunet.tm
+++ b/doc/scheme-gnunet.tm
@@ -1057,10 +1057,6 @@
   <scm|connect> <todo|document parameters>. It returns a <em|DHT server
   object>. <todo|disconnection / reconnection>
 
-  <\warning>
-    The code currently implements a different API. To be corrected soon!
-  </warning>
-
   <subsection|Data in the DHT>
 
   To insert data into the DHT, the DHT service needs various information \U
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index dc81244..7a0669a 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -263,7 +263,7 @@ undocumented and untested."
 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 (search-result->datum 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))))
 
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index c80abc4..6bf808c 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -26,6 +26,7 @@
        (rnrs exceptions)
        (rnrs conditions)
        (rnrs base)
+       (rnrs bytevectors)
        (srfi srfi-26)
        (srfi srfi-64))
 
@@ -104,8 +105,9 @@
 (define* (make-a-datum #:key
                       (type 0)
                       (key (make-slice/read-write (sizeof /hashcode:512 '())))
-                      (value (make-slice/read-write 0)))
-  (make-datum type key value))
+                      (value (make-slice/read-write 0))
+                      (expiration 0))
+  (make-datum type key value #:expiration expiration))
 (test-assert "datum?"
   (datum? (make-a-datum)))
 (test-equal "not a datum"
@@ -196,4 +198,71 @@
 ;; This detected a bug!
 (test-error "datum-type, wrong type (2)" (make-a-datum #:type 1.0))
 
+(define (slice->bytevector s)
+  (define b (make-bytevector (slice-length s)))
+  (define s2 (bv-slice/read-write b))
+  (slice-copy! s s2)
+  b)
+
+(define (datum->sexp z)
+   (list (datum-type z)
+        (slice->bytevector (datum-key z))
+        (slice->bytevector (datum-value z))
+        (datum-expiration z)))
+
+(define (search-result->sexp z)
+  (list (slice->bytevector (search-result-get-path z))
+       (slice->bytevector (search-result-put-path z))
+       (datum->sexp (search-result->datum z))))
+
+(define (datum=? x y)
+  (equal? (datum->sexp x) (datum->sexp y)))
+
+(define (search-result=? x y)
+  (equal? (search-result->sexp x) (search-result->sexp y)))
+
+(define (slice-independent? x y)
+  (not (eq? (slice-bv x) (slice-bv y))))
+
+(define (datum-independent? x y)
+  (and (slice-independent? (datum-key x) (datum-key y))
+       (slice-independent? (datum-value x) (datum-value y))))
+
+(define (search-result-independent? x y)
+  (and (datum-independent? (search-result->datum x) (search-result->datum y))
+       (slice-independent? (search-result-get-path x)
+                          (search-result-get-path y))
+       (slice-independent? (search-result-put-path x)
+                          (search-result-put-path y))))
+
+(test-assert "copy-datum: equal and independent"
+  ;; A least in Guile 3.0.5, all bytevectors of length 0 are eq?,
+  ;; so let the value be non-empty such that datum-independent?
+  ;; can return #true.
+  (let* ((old-key (make-slice/read-write (sizeof /hashcode:512 '())))
+        (old-value (make-slice/read-write 70))
+        (old (make-a-datum #:value old-value #:expiration 777)))
+    (slice-u32-set! old-key 9 #xcabba9e (endianness big))
+    (slice-u32-set! old-value 5 #xcabba9e (endianness big))
+    (let ((new (copy-datum old)))
+      (and (datum=? old new)
+          (datum-independent? old new)))))
+
+;; Detected a bug: the datum was not copied
+(test-assert "copy-search-result: equal and independent"
+  (let* ((old-key (make-slice/read-write (sizeof /hashcode:512 '())))
+        (old-value (make-slice/read-write 70))
+        (old-get-path (make-slice/read-write 9)) ; TODO: correct length
+        (old-put-path (make-slice/read-write 10)))
+    (slice-u32-set! old-key 9 #xcabba9e (endianness big))
+    (slice-u32-set! old-value 5 #xcabba9e (endianness big))
+    (slice-u32-set! old-get-path 0 #xcabba9e (endianness big))
+    (slice-u32-set! old-put-path 1 #xcabba9e (endianness big))
+    (let* ((old-datum (make-a-datum #:value old-value #:expiration 555))
+          (old (datum->search-result old-datum #:get-path old-get-path
+                                     #:put-path old-put-path))
+          (new (copy-search-result old)))
+      (and (search-result=? old new)
+          (search-result-independent? old new)))))
+
 (test-end)

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