[gnunet-scheme] 02/04: tests/distributed-hash-table: Test 'search-result'.

[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 c98d3467edfb4d5050ba0b2f3630227553190178
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Jan 18 11:41:47 2022 +0000

    tests/distributed-hash-table: Test 'search-result'.
    
    * tests/distributed-hash-table.scm (datum-key-test, datum-value-test):
      Extract some functionality to ...
      (slice-property-test): ... this procedure.
      (search-result-get-path-slice-test,search-result-put-path-slice-test):
      New macros.
      ("search-result-get-path, slice", "search-result-get-path, empty")
      ("search-result-put-path, slice", "search-result-put-path, empty")
      ("search-result-get-path, none", "search-result-put-path, none"):
      New tests.
---
 tests/distributed-hash-table.scm | 68 +++++++++++++++++++++++++++++-----------
 1 file changed, 49 insertions(+), 19 deletions(-)

diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index 6bf808c..54569fc 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -115,27 +115,28 @@
   (map datum? (list #false 'symbol (make-slice/read-write 0))))
 
 ;; For efficiency reasons, make sure the storage is reused.
-(define-syntax-rule (datum-key-test test-case k)
-  (test-assert test-case
-    (let* ((key k) ; only evaluate once, because eq? will be required
-          (datum (make-a-datum #:key key))
-          (new-key (datum-key datum)))
-      (and (datum? datum)
-          (slice-readable? new-key)
-          (not (slice-writable? new-key))
-          (eq? (slice-bv key) (slice-bv new-key))
-          (= (slice-length key) (slice-length new-key))))))
-(define-syntax-rule (datum-value-test test-case v)
+;;
+;; This verifies constructing a record and extracting a field from the record
+;; end ups with the value passed to the constructor, as a readable bytevector
+;; slice -- the writability of the original slice, if any, is removed.
+(define (slice-property-test test-case generate-slice stuff? slice->stuff 
stuff-slice)
   (test-assert test-case
-    (let* ((value v) ; only evaluate once, because eq? will be required
-          (datum (make-a-datum #:value value))
-          (new-value (datum-value datum)))
-      (and (datum? datum)
-          (slice-readable? new-value)
-          (not (slice-writable? new-value))
-          (eq? (slice-bv value) (slice-bv new-value))
-          (= (slice-length value) (slice-length new-value))))))
+    ;; only evaluate once, because eq? will be required
+    (let* ((slice (generate-slice))
+          (stuff (slice->stuff slice))
+          (new-slice (stuff-slice stuff)))
+      (and (stuff? stuff)
+          (slice-readable? new-slice)
+          (not (slice-writable? new-slice))
+          (eq? (slice-bv slice) (slice-bv new-slice))
+          (= (slice-length slice) (slice-length new-slice))))))
 
+(define-syntax-rule (datum-key-test test-case k)
+  (slice-property-test test-case (lambda () k) datum?
+                      (lambda (s) (make-a-datum #:key s)) datum-key))
+(define-syntax-rule (datum-value-test test-case v)
+  (slice-property-test test-case (lambda () v) datum?
+                      (lambda (s) (make-a-datum #:value s)) datum-value))
 (define-syntax-rule (datum-type-test test-case type type/integer)
   (test-equal test-case
     type/integer
@@ -265,4 +266,33 @@
       (and (search-result=? old new)
           (search-result-independent? old new)))))
 
+(define-syntax-rule (search-result-get-path-slice-test test-case k)
+  (slice-property-test test-case (lambda () k) search-result?
+                      (lambda (s) (datum->search-result (make-a-datum)
+                                                        #:get-path s))
+                      search-result-get-path))
+(define-syntax-rule (search-result-put-path-slice-test test-case k)
+  (slice-property-test test-case (lambda () k) search-result?
+                      (lambda (s) (datum->search-result (make-a-datum)
+                                                        #:put-path s))
+                      search-result-put-path))
+
+;; These detected a bug: the capabilities were not restricted!
+;; TODO: length
+;; TODO: can there be a get path without a put path?
+(search-result-get-path-slice-test "search-result-get-path, slice"
+                                  (make-slice/read-write 7))
+(search-result-get-path-slice-test "search-result-get-path, empty"
+                                  (make-slice/read-write 0))
+(search-result-put-path-slice-test "search-result-put-path, slice"
+                                  (make-slice/read-write 7))
+(search-result-put-path-slice-test "search-result-put-path, empty"
+                                  (make-slice/read-write 0))
+(test-equal "search-result-get-path, none"
+  (list #false) ; TODO: drop 'list' when SRFI-64 bug is fixed
+  (list (search-result-get-path (datum->search-result (make-a-datum)))))
+(test-equal "search-result-put-path, none"
+  (list #false) ; TODO: drop 'list' when SRFI-64 bug is fixed
+  (list (search-result-put-path (datum->search-result (make-a-datum)))))
+
 (test-end)

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