scheme-gnunet/tests/update.scm

;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021 GNUnet e.V.
;;
;; 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

(use-modules (gnu gnunet concurrency update)
	     (srfi srfi-8)
	     (srfi srfi-11)
	     (srfi srfi-26)
	     (fibers operations)
	     (fibers timers)
	     (fibers))

(test-begin "update")

;; Tests without concurrency
(test-equal "make-update result types"
  '(#t . #t)
  (receive (update update!)
      (make-update 0)
    (cons (update? update)
	  (procedure? update!))))

(test-equal "update! and next-update-peek"
  '(new #t #t)
  (let*-values (((update update!) (make-update 'old))
		((next-update next-update!) (update! 'new)))
    (receive (next-update-peeked) (next-update-peek update)
      (list (update-value next-update-peeked)
	    (procedure? next-update!)
	    (eq? next-update-peeked next-update)))))

(test-eq "no update! and next-update-peek"
  #f
  (next-update-peek (make-update 0)))

(test-error "update! twice -> &double-update"
  &double-update
  (receive (next-update next-update!)
      (make-update 0)
    (next-update! next-update)
    (next-update! next-update)))


;; Tests with operations

;; Unfortunately, fibers does not not have
;; a ‘run this operation -- unless it would
;; block’ procedure, and using a combination
;; of wrap-operation and sleep-operation/
;; timer-operation turns out to be racy.
;;
;; Our approach:
;;  * if an operation is expected to block,
;;    include a short timer-operation
;;    for testing detecting blocking.
;;    (Short to ensure tests still pass
;;    quickly.)
;;
;;    A false ‘PASS’ could occassionally
;;    result, but no false ‘FAIL’ will
;;    be created.
;;  * if a test is expected *not* to block,
;;    just perform the operation.
;;
;;    If the test terminates, it's a PASS,
;;    if it loops forever, that would be a FAIL.

(define expected-blocking-operation
  (wrap-operation (sleep-operation 1e-4)
		  (lambda () 'blocking)))

(test-eq "no update -> blocking next-update"
  'blocking
  (perform-operation
   (choice-operation
    (wrap-operation (wait-for-update-operation (make-update #f))
		    (lambda (_) 'nonblocking))
    expected-blocking-operation)))

(test-eq "updated -> non-blocking next-update"
  'nonblocking
  (perform-operation
   (receive (update update!)
       (make-update 'old)
     (update! 'new)
     (wrap-operation (wait-for-update-operation update)
		     (lambda (update) 'nonblocking)))))

(receive (update update!)
    (make-update 'old)
  (let ((new (update! 'new)))
    (test-eq "updated -> correct non-blocking next-update"
      new
      ;; For unknown reasons, using choice-operation
      ;; and blocking-operation leads to a FAIL.
      (perform-operation (wait-for-update-operation update)))))

(test-end "update")