[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 141/324: mq: Return the envelope after enqueueing and ad
From: |
gnunet |
Subject: |
[gnunet-scheme] 141/324: mq: Return the envelope after enqueueing and add more tests. |
Date: |
Tue, 21 Sep 2021 13:23:01 +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 e219c36fbbb5e469609af87b86d21f0dd7a6b1ce
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Jun 15 20:31:30 2021 +0200
mq: Return the envelope after enqueueing and add more tests.
If envelopes weren't returned, envelopes would be uncancellable.
* gnu/gnunet/mq.scm
(send-message!): Return the envelope. Document the envelope is
returned. Note that the envelope could be enqueued and sent
even if it isn't returned.
* test/mq.scm
(mhp, mhv, mq): Define helper variables.
("when injecting, handled message is eq?")
("non-zero types ok")
("verifier & handler only called once")
("missing header error")
("[prop] wrong header size error")
("returned envelope and sent envelope are equal")
("message might be enqueued & sent but not returned"): New tests
for message queues.
---
gnu/gnunet/mq.scm | 11 ++-
tests/mq.scm | 201 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 209 insertions(+), 3 deletions(-)
diff --git a/gnu/gnunet/mq.scm b/gnu/gnunet/mq.scm
index 779d031..89d5f6e 100644
--- a/gnu/gnunet/mq.scm
+++ b/gnu/gnunet/mq.scm
@@ -254,7 +254,13 @@ and when @code{try-send-again!} and @code{send-message!}
are not being
used concurrently on the same message queue.
When the message has been irrevocabily sent, the thunk @var{notify-sent!}
-will be called."
+will be called.
+
+After normal execution, the message envelope is returned,
+but in case of an exception (for example, an out-of-memory exception during
+the handling of a @code{&overly-full-queue-warning}), it is possible
+the envelope isn't returned even though it has been enqueued and it might
+perhaps be sent."
(define (cancel!)
(assert (and #f "cancel! not yet implemented")))
(assert (and (slice? message)
@@ -285,7 +291,8 @@ will be called."
;; TODO: consider
;; (@ (gnu gnunet mq) send!) here and elsewhere.
(make-who-condition 'send-message!)))))
- (try-send-again! mq))))
+ (try-send-again! mq)
+ envelope)))
(define (try-send-again! mq)
"Try to send messages in the queue @var{mq} that were not yet sent.
diff --git a/tests/mq.scm b/tests/mq.scm
index a9a3644..25038b1 100644
--- a/tests/mq.scm
+++ b/tests/mq.scm
@@ -26,11 +26,15 @@
(use-modules (ice-9 control)
(fibers conditions)
(fibers)
+ (srfi srfi-1)
(srfi srfi-26)
+ (srfi srfi-39)
(srfi srfi-43)
(srfi srfi-64)
(srfi srfi-111)
((rnrs base) #:select (assert mod))
+ ((rnrs exceptions) #:select (guard))
+ ((rnrs conditions) #:select (condition-who))
((rnrs arithmetic bitwise)
#:select (bitwise-ior))
(gnu gnunet netstruct syntactic)
@@ -45,7 +49,10 @@
(gnu gnunet message protocols)
(gnu gnunet mq)
(gnu gnunet mq envelope)
- (gnu gnunet mq handler))
+ (gnu gnunet mq handler)
+ (quickcheck property)
+ (quickcheck)
+ (quickcheck arbitrary))
;; The client code sends the numbers 0 to
;; NUM_TRANSMISSIONS-1 over the message queue.
@@ -494,3 +501,195 @@ with @code{x}."
(try-send-again! mq)
(vector-set! results N_THREAD (received/thread)))
(array-missing (results->array results))))
+
+
+
+;; Test message injection / handling (no exceptions).
+
+(define mhp (vector-unfold (lambda (_) (make-parameter #f)) 4))
+(define mhv (vector-unfold (lambda (_) (make-parameter #f)) 4))
+(define mh (apply message-handlers
+ (map (lambda (i)
+ (make-message-handler i (lambda (p) (p))
+ (lambda _
+ (apply ((vector-ref mhv i))
_))
+ (lambda _
+ (apply ((vector-ref mhp i))
_))))
+ (iota (vector-length mhp)))))
+
+;; FWIW, passing #f is not really allowed.
+(define mq (make-message-queue mh #f #f))
+
+(test-eq "when injecting, handled message is eq?"
+ #t
+ (let ((m (make-slice/read-write 40))) ; could as wel have been 20
+ (set%! /:message-header '(size)
+ (slice-slice m 0 (sizeof /:message-header '())) 40)
+ (let/ec ec
+ (parameterize (((vector-ref mhp 0)
+ (lambda (x)
+ (ec (eq? x m))))
+ ((vector-ref mhv 0)
+ (lambda (x)
+ (assert (eq? x m))
+ #t)))
+ (inject-message! mq m)
+ 'unreachable))))
+
+(test-eq "non-zero types ok"
+ #t
+ (let ((s (make-slice/read-write (sizeof /:message-header '()))))
+ (set%! /:message-header '(type) s 3)
+ (set%! /:message-header '(size) s (sizeof /:message-header '()))
+ (let/ec ec
+ (parameterize (((vector-ref mhp 3)
+ (lambda (x)
+ (ec (eq? x s))))
+ ((vector-ref mhv 3)
+ (lambda (x)
+ (assert (eq? s x))
+ #t)))
+ (inject-message! mq s)
+ 'unreachable))))
+
+(test-equal "verifier & handler only called once"
+ '(1 . 1)
+ (let ((hcount 0)
+ (vcount 0)
+ (s (make-slice/read-write (sizeof /:message-header '()))))
+ (set%! /:message-header '(size) s (sizeof /:message-header '()))
+ (parameterize (((vector-ref mhp 0)
+ (lambda (x)
+ (set! hcount (+ 1 hcount))
+ (assert (eq? x s))
+ (values)))
+ ((vector-ref mhv 0)
+ (lambda (x)
+ (set! vcount (+ 1 vcount))
+ (assert (eq? x s))
+ #t)))
+ (inject-message! mq s)
+ (cons hcount vcount))))
+
+
+
+;; Test message injection (exceptions)
+(test-equal "missing header error"
+ (map (lambda (i)
+ `(missing-header-error (size . ,i)
+ (who . inject-message!)))
+ (iota (sizeof /:message-header '())))
+ (map (lambda (i)
+ (guard (e ((missing-header-error? e)
+ `(missing-header-error
+ (size . ,(missing-header-error-received-size e))
+ (who . ,(condition-who e)))))
+ (inject-message! mq (make-slice/read-write i))
+ 'unreachable))
+ (iota (sizeof /:message-header '()))))
+
+(test-assert "[prop] wrong header size error"
+ (quickcheck
+ (property ((%real-length $natural)
+ (supposed-length $natural))
+ (let* ((real-length (+ (sizeof /:message-header '())
+ %real-length))
+ (supposed-length (if (= real-length supposed-length)
+ (+ 1 supposed-length)
+ supposed-length))
+ (s (make-slice/read-write real-length))
+ (sheader (slice-slice s 0 (sizeof /:message-header '()))))
+ (set%! /:message-header '(size)
+ (slice-slice s 0 (sizeof /:message-header '()))
+ supposed-length)
+ (guard (e ((size-mismatch-error? e)
+ (equal? `(,(size-mismatch-error-expected-size e)
+ ,(size-mismatch-error-received-size e)
+ ,(condition-who e))
+ `(,supposed-length
+ ,real-length
+ inject-message!))))
+ (inject-message! mq s)
+ #f)))))
+
+;; TODO: what if the message is (otherwise) malformed?
+
+
+
+;; Test the following part of the send-message! docstring:
+;; ‘After normal execution, the message envelope is returned,
+;; but in case of an exception (for example, an out-of-memory exception
+;; during the handling of a @code{&overly-full-queue-warning}), it is
+;; possible the envelope isn't returned even though it has been enqueued
+;; and it might perhaps be sent.
+(test-assert "returned envelope and sent envelope are equal"
+ (let* ((returned-values #f)
+ (sent-values #f)
+ (sender
+ (make-one-by-one-sender
+ (lambda envelope-arguments
+ (assert (eq? sent-values #f))
+ (set! sent-values envelope-arguments)
+ (values))))
+ (mq (make-message-queue #f #f sender))
+ (msg (index->dummy #xdeadbeef)))
+ (call-with-values
+ (lambda () (send-message! mq msg))
+ (lambda return-values
+ (set! returned-values return-values)))
+ (and (equal? sent-values returned-values)
+ (= (length sent-values) 1)
+ (every envelope? sent-values))))
+
+;; Strictly speaking, this test is allowed to fail
+;; (as it is only ‘might’, not ‘it must be possible’),
+;; but it seems a good idea to check our understanding is correct.
+(test-assert "message might be enqueued & sent but not returned"
+ (let* ((enqueued? #f)
+ (flush? (make-parameter #f))
+ (sender/flush
+ (make-one-by-one-sender
+ (lambda (envelope)
+ (set! enqueued? envelope)
+ (values))))
+ (sender/hold
+ (lambda _ (values)))
+ (sender (make-sender/choice flush? sender/hold
+ sender/flush))
+ (mq (make-message-queue #f #f sender))
+ (msg (index->dummy 0))
+ (exceptional #f)
+ (enveloped #f))
+ (with-exception-handler
+ (lambda (_)
+ (assert exceptional)
+ (assert (envelope? enqueued?))
+ (assert (not enveloped)))
+ (lambda ()
+ (with-exception-handler
+ (lambda (e)
+ (if (overly-full-queue-warning? e)
+ (begin
+ (set! exceptional #t)
+ (parameterize ((flush? #t))
+ (try-send-again! mq)
+ ;; At least in the current implementation,
+ ;; this holds.
+ ;;
+ ;; In a different implementation, the
+ ;; envelope could be enqueued after
+ ;; checking the queue length.
+ (assert enqueued?))
+ (throw 'out-of-memory))
+ (raise-exception e #:continuable? #t)))
+ (lambda ()
+ (call-with-values
+ (lambda ()
+ (parameterize ((%suspicious-length 0))
+ (send-message! mq msg)))
+ (lambda args (set! enveloped args))))
+ #:unwind? #f))
+ #:unwind? #t
+ #:unwind-for-type 'out-of-memory)
+ (and enqueued? exceptional
+ (not enveloped))))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 114/324: config: parser: More TODOs about the configuration format., (continued)
- [gnunet-scheme] 114/324: config: parser: More TODOs about the configuration format., gnunet, 2021/09/21
- [gnunet-scheme] 119/324: netstruct: Correct size of u8., gnunet, 2021/09/21
- [gnunet-scheme] 122/324: netstruct: Pass index for u8 (zero)., gnunet, 2021/09/21
- [gnunet-scheme] 123/324: netstruct: Select a part of the slice before trying to read., gnunet, 2021/09/21
- [gnunet-scheme] 124/324: netstruct: Use the correct size for bounds checking in 'select'., gnunet, 2021/09/21
- [gnunet-scheme] 130/324: mq: New module, replacing message-io., gnunet, 2021/09/21
- [gnunet-scheme] 132/324: mq: Do not hardcode suspicious queue length., gnunet, 2021/09/21
- [gnunet-scheme] 133/324: mq: Pluralise ‘message-queue-handler’., gnunet, 2021/09/21
- [gnunet-scheme] 137/324: mq: Make %suspicious-length a sort-of exported parameter., gnunet, 2021/09/21
- [gnunet-scheme] 139/324: mq: Make accessors of &overly-full-queue-warnings predictably named., gnunet, 2021/09/21
- [gnunet-scheme] 141/324: mq: Return the envelope after enqueueing and add more tests.,
gnunet <=
- [gnunet-scheme] 147/324: Merge branch 'master' into proper-mq, gnunet, 2021/09/21
- [gnunet-scheme] 97/324: utils: bv-slice: Define a record printer., gnunet, 2021/09/21
- [gnunet-scheme] 118/324: netstruct: Fix field lookup and offset calculation., gnunet, 2021/09/21
- [gnunet-scheme] 140/324: mq: Export &overly-full-queue-warning and friends., gnunet, 2021/09/21
- [gnunet-scheme] 144/324: mq: Test message cancellation., gnunet, 2021/09/21
- [gnunet-scheme] 145/324: mq: envelope: Correct spelling in comments and docstrings., gnunet, 2021/09/21
- [gnunet-scheme] 87/324: mq: define message queue module, gnunet, 2021/09/21
- [gnunet-scheme] 96/324: doc: Fix typo in README.org., gnunet, 2021/09/21
- [gnunet-scheme] 102/324: tests: config-parser: Don't generate inexact numbers., gnunet, 2021/09/21
- [gnunet-scheme] 116/324: utils: hat-let: Fix inline procedure definitions., gnunet, 2021/09/21