[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 110/324: config: Define a quaject for quering and modify
From: |
gnunet |
Subject: |
[gnunet-scheme] 110/324: config: Define a quaject for quering and modifying a configuration. |
Date: |
Tue, 21 Sep 2021 13:22:30 +0200 |
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.
- [gnunet-scheme] 80/324: Define various common network structures, (continued)
- [gnunet-scheme] 80/324: Define various common network structures, gnunet, 2021/09/21
- [gnunet-scheme] 86/324: doc: Update the roadmap on Guix + GNUnet., gnunet, 2021/09/21
- [gnunet-scheme] 84/324: utils: correct definition of unsigned integers, gnunet, 2021/09/21
- [gnunet-scheme] 76/324: scripts: download-store: make dependency on guix optional, gnunet, 2021/09/21
- [gnunet-scheme] 83/324: Document the current state of message queues., gnunet, 2021/09/21
- [gnunet-scheme] 85/324: mq: Do not include callbacks in envelopes., gnunet, 2021/09/21
- [gnunet-scheme] 91/324: Define slice-copy! and slice-zero!., gnunet, 2021/09/21
- [gnunet-scheme] 90/324: icmp: Define some packet types and error codes., gnunet, 2021/09/21
- [gnunet-scheme] 100/324: config: parser: Define return types for expansion parser., gnunet, 2021/09/21
- [gnunet-scheme] 108/324: tets: message-handler: Correct imports., gnunet, 2021/09/21
- [gnunet-scheme] 110/324: config: Define a quaject for quering and modifying a configuration.,
gnunet <=
- [gnunet-scheme] 71/324: doc: Document maintainer quirk, gnunet, 2021/09/21
- [gnunet-scheme] 77/324: util: add missing import, gnunet, 2021/09/21
- [gnunet-scheme] 82/324: Implement self-documenting ‘network structures’, gnunet, 2021/09/21
- [gnunet-scheme] 88/324: mq: Move message queue modules to (gnu gnunet mq SOMETHING)., gnunet, 2021/09/21
- [gnunet-scheme] 101/324: utils: hat-let: Add <--, a variant on <-., gnunet, 2021/09/21
- [gnunet-scheme] 89/324: doc: Document current list of defined GNUnet network structures., gnunet, 2021/09/21
- [gnunet-scheme] 94/324: bv-slice: Correct offset calculation in slice-slice., gnunet, 2021/09/21
- [gnunet-scheme] 98/324: utils: Define module for defining platform-specifing enumerations., gnunet, 2021/09/21
- [gnunet-scheme] 95/324: util: Allow splitting and constructing ancillary messages., gnunet, 2021/09/21
- [gnunet-scheme] 103/324: config: parser: parse ${variable} expansions., gnunet, 2021/09/21