[gnunet-scheme] 110/324: config: Define a quaject for quering and modifying a configuration.

[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 5875f107ee32299ebc54e9520a28d26fc05473ba
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Apr 15 16:33:04 2021 +0200

    config: Define a quaject for quering and modifying a configuration.
    
    * gnu/gnunet/config/db.scm: Define <configuration> quaject.
    * tests/config-db.scm: Test the quaject, and the hash table
      implementation.
    * Makefile.am (modules): Compile the new module.
      (SCM_TESTS): Run the new tests.
    * README.org (Modules)[Configuration]: Note the new module exists.
---
 Makefile.am              |   4 +-
 README.org               |   3 +-
 gnu/gnunet/config/db.scm | 208 +++++++++++++++++++++++++++
 tests/config-db.scm      | 362 +++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 575 insertions(+), 2 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index cfad81f..bf1f3a8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -51,6 +51,7 @@ modules = \
   gnu/gnunet/config/parser.scm \
   gnu/gnunet/config/value-parser.scm \
   gnu/gnunet/config/expand.scm \
+  gnu/gnunet/config/db.scm \
   \
   gnu/gnunet/util/cmsg.scm \
   gnu/gnunet/icmp/struct.scm \
@@ -103,7 +104,8 @@ SCM_TESTS = \
   tests/cmsg.scm \
   tests/config-parser.scm \
   tests/config-value-parser.scm \
-  tests/config-expander.scm
+  tests/config-expander.scm \
+  tests/config-db.scm
 
 SCM_TESTS_ENVIRONMENT = \
   GUILE_AUTO_COMPILE=0 \
diff --git a/README.org b/README.org
index 1e5b432..f6e8108 100644
--- a/README.org
+++ b/README.org
@@ -87,8 +87,9 @@
    + gnu/gnunet/config/expand.scm: Perform variable expansion.
    + gnu/gnunet/config/value-parser.scm: Parse configuration values.
      TODO: value->data, value->relative-time
+   + gnu/gnunet/config/db.scm: Quaject for configurations.
 
-   TODO: writing, modifying, querying ...
+   TODO: modifying, update notifications, loading ...
 ** Network structures                                             :good:wart:
    Features:
 
diff --git a/gnu/gnunet/config/db.scm b/gnu/gnunet/config/db.scm
new file mode 100644
index 0000000..252b594
--- /dev/null
+++ b/gnu/gnunet/config/db.scm
@@ -0,0 +1,208 @@
+;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;; Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
+;;
+;; 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
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;   SPDX-License-Identifier: AGPL-3.0-or-later
+
+;; Brief: A quaject for keeping configuration together.
+;; Author: Maxime Devos
+;; This module has quite some differences from the C implementation.
+
+(define-library (gnu gnunet config db)
+  (export <configuration>
+         make-configuration
+         configuration?
+         read-value
+         set-value!
+         undefine-key!
+         #; notify-me-on-change!
+
+         &config-error make-config-error config-error?
+         config-error-section config-error-key
+         &undefined-key-error make-undefined-key-error undefined-key-error?
+         &unwritable-key-error make-unwritable-key-error unwritable-key-error?
+         &unundefinable-key-error make-unundefinable-key-error
+         unundefinable-key-error?
+
+         hash->configuration
+         hash-key key=?)
+  (import (only (rnrs base)
+               begin define lambda assert cons string? if
+               let values and eq? + car cdr string=?)
+         (only (rnrs exceptions)
+               raise)
+         (only (rnrs records syntactic)
+               define-record-type)
+         (only (rnrs conditions)
+               define-condition-type &error)
+         (only (rnrs hashtables)
+               hashtable-ref hashtable-set! hashtable-delete!
+               hashtable-contains? hashtable? hashtable-mutable?
+               string-hash)
+         (srfi srfi-26)
+         (only (srfi srfi-8)
+               receive)
+         (only (ice-9 optargs)
+               lambda*))
+  (begin
+    (define-condition-type &config-error &error
+      make-config-error config-error?
+      (section config-error-section)
+      (key config-error-key))
+
+    (define-condition-type &undefined-key-error &config-error
+      make-undefined-key-error undefined-key-error?)
+    (define-condition-type &unwritable-key-error &config-error
+      make-unwritable-key-error unwritable-key-error?)
+    (define-condition-type &unundefinable-key-error &config-error
+      make-unundefinable-key-error unundefinable-key-error?)
+
+    
+    ;; The configuration quaject.
+    ;; The concept quaject is documented in
+    ;; <https://valerieaurora.org/synthesis/SynthesisOS/ch4.html>.
+
+    (define (default-read-value/raw section key)
+      (raise (make-undefined-key-error section key)))
+    (define (default-set-value!/raw section key value)
+      (raise (make-unwritable-key-error section key)))
+    (define (default-undefine-key! section key)
+      (raise (make-unundefinable-key-error section key)))
+
+    (define-record-type (<configuration> make-configuration configuration?)
+      (fields (mutable read-value/raw %read-value/raw %set-read-value/raw!)
+             (mutable set-value!/raw %set-value!/raw %set-set-value!/raw!)
+             (mutable undefine-key! %undefine-key! %set-undefine-key!!)
+             #;(immutable notify-me-on-change! ...))
+      (sealed #f)
+      (opaque #t)
+      (protocol (lambda (%make)
+                 (lambda* (#:key
+                           (read-value/raw default-read-value/raw)
+                           (set-value!/raw default-set-value!/raw)
+                           (undefine-key! default-undefine-key!))
+                   "Make a configuration quaject, that reads configuration
+values with the callentry @var{read-value/raw}, writes configuration values
+with the callentry @var{set-value!/raw} and undefines values with the
+callentry @var{undefine-key!}.  They default to procedures raising
+a @code{&undefined-key-error}, @code{&unwritable-key-error} and
+@code{&unundefinable-key-error} respectively.
+
+The @var{read-value/raw} callentry accepts a section and key as strings,
+and is expected to return a string or raise a @code{&undefined-key-error}.
+The @var{undefine-key!} callentry accepts a section and key as strings,
+and is expected to raise a @code{&unundefinable-key-error} when appropriate
+(e.g. when the key was already undefined).
+The @var{set-value!/raw} callentry accepts a section, key and value as string,
+and is expected to raise a @code{&unwritable-key-error} when appropriate
+(e.g. the configuration is read-only).
+
+Three additional values are returned: a mutator for the @var{read-value/raw},
+@var{set-value!/raw} and @var{undefine-key!} callentries.  More values may be
+returned in a later version."
+                   (let ((c (%make read-value/raw set-value!/raw
+                                   undefine-key!)))
+                     (values c
+                             (cut %set-read-value/raw! c <>)
+                             (cut %set-set-value!/raw! c <>)
+                             (cut %set-undefine-key!! c <>)))))))
+
+    (define (read-value value->object config section key)
+      "Return the value of the key @var{key} in the section @var{section}
+of the configuration @var{config}.  The raw value string with
+@var{value->object} in tail position.  The raw value is retrieved with
+the @code{read-value/raw} callentry of @var{config}, which is expected
+to raise a @code{&undefined-key-error} exception when appropriate, which will
+be propagated."
+      (value->object ((%read-value/raw config) section key)))
+
+    (define (set-value! object->value config section key object)
+      "Write the object @var{object} to the key @var{key} in the section
+@var{section} in the configuration @var{config}.  The conversion to a
+raw value string is done with @var{object->value}.  The raw value is
+written with the @code{set-value!/raw} callentry of @var{config}, which
+is expected to raise a @code{&unwritable-key-error} exception when appropriate,
+which will be propagated."
+      ((%set-value!/raw config) section key (object->value object)))
+
+    (define (undefine-key! config section key)
+      "Undefine the value of the key @var{key} in the section @var{section}
+of the configuration @var{config}.  When appropriate (e.g. the configuration
+is read-only or the key is already undefined), the @code{undefine-key!}
+callentry of @var{config} is expected to raise a
+@code{&unundefinable-key-error}, which will be propagated."
+      ((%undefine-key! config) section key))
+
+    
+    ;; Configuration quaject implementation.
+    (define *unequal* (cons #f #f))
+
+    (define (hash-key section+key)
+      "Hash a @code{(section . key)} pair, for use in R6RS hash tables."
+      ;; Wild guess.
+      (+ (string-hash (car section+key))
+        (string-hash (cdr section+key))))
+    (define (key=? section+key/1 section+key/2)
+      (and (string=? (car section+key/1) (car section+key/2))
+          (string=? (cdr section+key/1) (cdr section+key/2))))
+
+    (define (hash->configuration hash)
+      "Make a configuration quaject backed by the hash table @var{table}.
+The keys are pairs @code{(section . key)}, where @var{section} and @var{key}
+are strings.  The values are the raw string values.  The contents of
+@var{hash} is not verified, but presumed to be correctly typed.
+
+Currently, one additional value is returned: a mutator for replacing the
+hash table in use.  Replacing the hash table is not an atomic operation;
+while the hash table is being replaced, either the new or the old hash
+table will be used by the callentries."
+      (define (%read-value/raw hash section key)
+       (assert (and (string? section) (string? key)))
+       ;; Grrr SRFI hash-table-ref is nicer
+       (let ((value (hashtable-ref hash (cons section key) *unequal*)))
+         (if (eq? *unequal* value)
+             (raise (make-undefined-key-error section key))
+             value)))
+      (define (%set-value!/raw-mutable hash section key value)
+       (assert (and (string? section) (string? key) (string? value)))
+       (hashtable-set! hash (cons section key) value))
+      (define (%undefine-key!/mutable hash section key)
+       (assert (and (string? section) (string? key)))
+       (let ((k (cons section key)))
+         (if (hashtable-contains? hash k)
+             (hashtable-delete! hash (cons section key))
+             (raise (make-unundefinable-key-error section key)))))
+      (receive (c set-read-value/raw! set-set-value!/raw!
+                 set-undefine-key!!)
+         (make-configuration
+          #:read-value/raw (cut %read-value/raw hash <> <>)
+          #:set-value!/raw (if (hashtable-mutable? hash)
+                               (cut %set-value!/raw-mutable hash <> <> <>)
+                               default-set-value!/raw)
+          #:undefine-key!  (if (hashtable-mutable? hash)
+                               (cut %undefine-key!/mutable hash <> <>)
+                               default-undefine-key!))
+       (values c
+               (lambda (hash)
+                 (assert (hashtable? hash))
+                 (set-read-value/raw! (cut %read-value/raw hash <> <>))
+                 (set-set-value!/raw!
+                  (if (hashtable-mutable? hash)
+                      (cut %set-value!/raw-mutable hash <> <> <>)
+                      default-set-value!/raw))
+                 (set-undefine-key!!
+                  (if (hashtable-mutable? hash)
+                      (cut %undefine-key!/mutable hash <> <>)
+                      default-undefine-key!))))))))
diff --git a/tests/config-db.scm b/tests/config-db.scm
new file mode 100644
index 0000000..30f1507
--- /dev/null
+++ b/tests/config-db.scm
@@ -0,0 +1,362 @@
+;; This file is part of scheme-GNUnet.
+;; Copyright (C) 2021 Maxime Devos
+;;
+;; 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
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; scheme-GNUnet is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL3.0-or-later
+
+;; Bugs found with these tests:
+;;  * [I] missing arguments to %make
+;;  * [I] forgot to export &unwritable-key-error and friends
+;;  * [I] forgot to export undefine-key!
+;;  * [I] missing arguments for default-set-value!/raw
+;;  * [I] undefine-key! on configurations backed by a hash table
+;;        did not produce an exception
+
+(use-modules (gnu gnunet config db)
+            (rnrs hashtables)
+            (srfi srfi-8)
+            ((rnrs base) #:select (assert))
+            (ice-9 control))
+
+;; Convert the exception into a S-expression
+;; to be able to compare results with @code{equal?}.
+(define (call-with-return-exceptions fun . args)
+  (with-exception-handler
+      (lambda (e)
+       (list
+        (cond ((undefined-key-error? e) 'not-found)
+              ((unwritable-key-error? e) 'unwritable)
+              ((unundefinable-key-error? e) 'unundefinable))
+        (config-error-section e)
+        (config-error-key e)))
+    (lambda () (apply fun args))
+    #:unwind? #t
+    #:unwind-for-type &config-error))
+
+(define (read-value/scatch config section key)
+  (call-with-return-exceptions
+   (lambda ()
+     `(found . ,(read-value identity config section key)))))
+
+(define (set-value!/s config section key value)
+  (set-value! identity config section key value))
+(define (set-value!/scatch config section key value)
+  (call-with-return-exceptions
+   (lambda () (set-value!/s config section key value))))
+(define (undefine-key!/catch config section key)
+  (call-with-return-exceptions
+   (lambda () (undefine-key! config section key) 'ok)))
+
+(define (alist->hash alist)
+  (let ((h (make-hashtable hash-key key=?)))
+    (for-each (lambda (key+value)
+               (hashtable-set! h (car key+value) (cdr key+value)))
+             alist)
+    h))
+
+(test-equal "make-configuration return types"
+  '(#t #t #t #t)
+  (receive (c set-read-value/raw! set-set-value!/raw! set-undefine-key!!)
+      (make-configuration)
+    (list (configuration? c)
+         (procedure? set-read-value/raw!)
+         (procedure? set-set-value!/raw!)
+         (procedure? set-undefine-key!!))))
+
+(define-syntax-rule (test-eqnh desc . rest)
+  (test-equal (string-append "hash->configuration, " desc) . rest))
+
+(define-syntax-rule (test-newhash-read desc expected alist section key)
+  (test-equal (string-append "hash->configuration, read-value, " desc)
+    expected
+    (read-value/scatch
+     (hash->configuration (alist->hash alist))
+     section key)))
+
+(test-newhash-read "match" '(found . "value") '((("section" . "x") . "value"))
+                  "section" "x")
+(test-newhash-read "section does not match"
+                  '(not-found "sect" "x")
+                  '((("section" . "x") . "value"))
+                  "sect" "x")
+(test-newhash-read "key does not match"
+                  '(not-found "section" "y")
+                  '((("section" . "x") . "value"))
+                  "section" "y")
+
+(define-syntax-rule (test-reflect desc alist
+                                 (h c . rest)
+                                 (section key expected)
+                                 (section* key* expected*)
+                                 mutate)
+  (test-eqnh desc
+            '(expected expected*)
+            (let ((h (alist->hash alist)))
+              (receive (c . rest) (hash->configuration h)
+                (let ((old (read-value/scatch c section key)))
+                  mutate
+                  (list old (read-value/scatch c section* key*)))))))
+
+
+
+;; In the docstring, it is specified the hash table is used
+;; -- not a *copy* of the hash table.
+
+(test-reflect "read-value reflects hash (modified value)"
+             '((("section" . "x") . "value"))
+             (h c . _)
+             ("section" "x" (found . "value"))
+             ("section" "x" (found . "value2"))
+             (hashtable-set! h '("section" . "x") "value2"))
+
+(test-reflect "read-value reflects hash (deleted value)"
+             '((("section" . "x") . "value"))
+             (h c . _)
+             ("section" "x" (found . "value"))
+             ("section" "x" (not-found "section" "x"))
+             (hashtable-delete! h '("section" . "x")))
+
+(test-reflect "read-value reflects hash (new value)"
+             '()
+             (h c . _)
+             ("section" "x" (not-found "section" "x"))
+             ("section" "x" (found . "value"))
+             (hashtable-set! h '("section" . "x") "value"))
+
+;; The hash table is modified, not copied.
+;; Also, new values are visible from read-value.
+(test-reflect "set-value! & read-value, in-place (new)"
+             '()
+             (h c . _)
+             ("section" "x" (not-found "section" "x"))
+             ("section" "x" (found . "value"))
+             (begin
+               (set-value!/s c "section" "x" "value")
+               (assert (hashtable-contains? h `(,"section" . ,"x")))))
+
+
+
+;; Make sure all callentries are adjusted to use the new hash.
+(test-reflect "read-value reflects new hash (modified value)"
+             '((("section" . "x") . "value"))
+             (h c set-hash!)
+             ("section" "x" (found . "value"))
+             ("section" "x" (found . "value2"))
+             (set-hash! (alist->hash '((("section" . "x") . "value2")))))
+
+(test-reflect "read-value reflects new hash (deleted value)"
+             '((("section" . "x") . "value"))
+             (h c set-hash!)
+             ("section" "x" (found . "value"))
+             ("section" "x" (not-found "section" "x"))
+             (set-hash! (alist->hash '())))
+
+(test-reflect "read-value reflects new hash (new value)"
+             '()
+             (h c set-hash!)
+             ("section" "x" (not-found "section" "x"))
+             ("section" "x" (found . "value"))
+             (set-hash! (alist->hash '((("section" . "x") . "value")))))
+
+;; Changing from a mutable to immutable hash (set-value!).
+;;
+;; set-hash! might have forgotten to change the set-value!
+;; callentry correctly, in which case:
+;;  (a) the callentry uses the new (immutable) hash,
+;;      and tries to modify it.  In that case, (rnrs hashtables)
+;;      would raise an exception, which will not be &unwritable-key-error.
+;;      --> FAIL.
+;;  (b) the callentry is unchanged, and uses the old hash.  In that case,
+;;      no exception would be raised.
+;;      --> FAIL
+
+(test-eqnh "set-value! fails gracefully (mutable -> immutable hash)"
+          '(unwritable "the-section" "the-key")
+          (receive (c set-hash!)
+              (hash->configuration (alist->hash '()))
+            (set-hash! (hashtable-copy (alist->hash '()) #f))
+            (set-value!/scatch c "the-section" "the-key" "the-value")))
+
+;; Changing from an immutable to mutable hash (set-value!).
+;;
+;; set-hash! might have forgotten to change the set-value!
+;; callentry correctly, in which case:
+;; (a) the callentry uses the new (mutable) hash, but believes it to be
+;;     immutable, resulting in an &unwritable-key-error.
+;;     --> FAIL.
+;; (b) the callentry is unchanged, and uses the old hash, resulting in
+;;     an &unwritable-key-error
+;;     --> FAIL.
+(test-eqnh "set-value! + read-value succeeds (immutable -> mutable hash)"
+          '(found . "the-value")
+          (receive (c set-hash!)
+              (hash->configuration (hashtable-copy (alist->hash '()) #f))
+            (set-hash! (alist->hash '()))
+            (set-value!/s c "the-section" "the-key" "the-value")
+            (read-value/scatch c "the-section" "the-key")))
+
+;; Changing from a mutable to immutable hash (undefine-key!).
+;;
+;; set-hash! might have forgotten to change the undefine-key!
+;; callentry, in which case:
+;;  (a) the callentry uses the new (immutable) hash, but believes it to
+;;      be mutable, resulting in an exception from (rnrs hashtables)
+;;      instead of an &unundefinable-key-error.
+;;      --> FAIL
+;;  (b) the callentry uses the old (mutable) hash, in which case no
+;;      &unundefinable-key-error is raised.
+;;      --> FAIL
+(test-eqnh "undefine-key! fails (mutable -> immutable, key exists)"
+          '(unundefinable "a-section" "a-key")
+          (receive (c set-hash!)
+              (hash->configuration
+               (alist->hash '((("a-section" . "a-key") "a-value"))))
+            (set-hash!
+             (hashtable-copy (alist->hash '((("a-section" . "a-key") 
"a-value")))
+                             #f))
+            (undefine-key!/catch c "a-section" "a-key")))
+
+;; undefine-key! should fail because there is no such key to undefine.
+(test-eqnh "undefine-key! fails (mutable -> immutable, key does not exists)"
+          '(unundefinable "a-section" "a-key")
+          (receive (c set-hash!)
+              (hash->configuration (alist->hash '()))
+            (set-hash! (hashtable-copy (alist->hash '()) #f))
+            (undefine-key!/catch c "a-section" "a-key")))
+
+(test-eqnh "undefine-key! fails (mutable -> immutable, key disappears)"
+          '(unundefinable "a-section" "a-key")
+          (receive (c set-hash!)
+              (hash->configuration
+               (alist->hash '((("a-section" . "a-key") "a-value"))))
+            (set-hash! (hashtable-copy (alist->hash '()) #f))
+            (undefine-key!/catch c "a-section" "a-key")))
+
+(test-eqnh "undefine-key! fails (mutable -> immutable, key appears)"
+          '(unundefinable "a-section" "a-key")
+          (receive (c set-hash!)
+              (hash->configuration (alist->hash '()))
+            (set-hash!
+             (hashtable-copy (alist->hash '((("a-section" . "a-key") . 
"a-value")))
+                             #f))
+            (undefine-key!/catch c "a-section" "a-key")))
+
+;; Changing from a mutable to immutable hash (undefine-key!).
+;;
+;; set-hash! might have forgotten to change the undefine-key!
+;; callentry, in which case:
+;; (a) the undefine-key! callentry believes the hash table
+;;     is still immutable, leading to an &unundefinable-key-error
+;; (b) the undefine-key! callentry uses the new hash table,
+;;     but believes it is immutable, leading to an &unundefinable-key-error
+
+(test-eqnh "undefine-key! succeeds correctly (immutable -> mutable, key 
exists)"
+          '(ok . #f)
+          (receive (c set-hash!)
+              (hash->configuration
+               (hashtable-copy (alist->hash '((("b-section" . "b-key") . 
"b-value")))
+                               #f))
+            (let ((new (hashtable-copy
+                        (alist->hash '((("b-section" . "b-key") . "b-value")))
+                        #t)))
+              (set-hash! new)
+              (let ((u (undefine-key!/catch c "b-section" "b-key")))
+                (cons u (hashtable-contains? new '("b-section" . "b-key")))))))
+
+(test-eqnh "undefine-key! succeeds correctly (immutable -> mutable, key 
appears)"
+          '(ok . #f)
+          (receive (c set-hash!)
+              (hash->configuration
+               (hashtable-copy (alist->hash '()) #f))
+            (let ((new (alist->hash '((("b-section" . "b-key") . "b-value")))))
+              (set-hash! new)
+              (let ((u (undefine-key!/catch c "b-section" "b-key")))
+                (cons u (hashtable-contains? new '("b-section" . "b-key")))))))
+
+(test-eqnh "undefine-key! fails correctly (immutable -> mutable, key does not 
exist)"
+          '((unundefinable "b-section" "b-key") . #f)
+          (receive (c set-hash!)
+              (hash->configuration
+               (hashtable-copy (alist->hash '()) #f))
+            (let ((new (alist->hash '())))
+              (set-hash! new)
+              (let ((u (undefine-key!/catch c "b-section" "b-key")))
+                (cons u (hashtable-contains? new '("b-section" . "b-key")))))))
+
+(test-eqnh "undefine-key! fails correctly (immutable -> mutable, key 
disappears)"
+         '((unundefinable "c-section" "c-key") . #f)
+         (receive (c set-hash!)
+             (hash->configuration
+              (hashtable-copy (alist->hash '((("c-section" . "c-key") . 
"c-value")))
+                              #f))
+           (let ((new (alist->hash '())))
+             (set-hash! new)
+             (let ((u (undefine-key!/catch c "c-section" "c-key")))
+               (cons u (hashtable-contains? new '("c-section" . "c-key")))))))
+
+(test-eqnh "undefine-key! is not simply hashtable-clear!"
+          '(found . "w")
+          (receive (c _)
+              (hash->configuration
+               (alist->hash '((("x" . "y") . "z") (("u" . "v") . "w"))))
+            (undefine-key! c "x" "y")
+            (read-value/scatch c "u" "v")))
+
+
+;; We've neglected the object->value an value->object arguments
+;; in the previous tests.
+
+(test-equal "read-value, string->number"
+  #x12
+  (read-value string->number (hash->configuration
+                             (alist->hash '((("x" . "y") . "#x12")))) "x" "y"))
+
+(define (calls-in-tail-position? proc)
+  (= 1 (stack-length (make-stack (let ((t (make-prompt-tag 'tail-position?)))
+                                  (call-with-prompt t
+                                    (lambda () (proc
+                                                (lambda () (abort-to-prompt 
t))))
+                                    identity))))))
+
+(test-assert "read-value, object->value in tail position"
+  (calls-in-tail-position?
+   (let ((c (hash->configuration (alist->hash '((("x" . "y") . "#x12"))))))
+     (lambda (thunk)
+       (read-value (lambda (x) (thunk)) c "x" "y")))))
+
+(test-equal "set-value!, object->value has correct argument"
+  'value
+  (let/ec ec
+    (set-value! ec
+               (hash->configuration (alist->hash '()))
+               "section" "key"
+               'value)
+    'what))
+
+;; TODO: verify
+;; Replacing the hash table is not an atomic operation;
+;; while the hash table is being replaced, either the new or the old hash
+;; table will be used by the callentries.
+
+;; Check the defaults callentries.
+(test-equal "read-value, default callentry"
+  '(not-found "x" "y")
+  (read-value/scatch (make-configuration) "x" "y"))
+(test-equal "set-value!, default callentry"
+  '(unwritable "x" "y")
+  (set-value!/scatch (make-configuration) "x" "y" "z"))
+(test-equal "undefine-key!, default callentry"
+  '(unundefinable "x" "y")
+  (undefine-key!/catch (make-configuration) "x" "y"))

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