;;; Copyright 2019-2021 Christine Lemmer-Webber
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (pre-goblins test-stage2)
  #:use-module (pre-goblins stage2)
  #:use-module (srfi srfi-64))

(test-begin "test-goblins-stage2")>

(define am (make-whactormap))

(define (^greeter _bcom my-name)
  (lambda (your-name)
    (format #f "Hello ~a, my name is ~a!" your-name my-name)))

(define alice
  (actormap-spawn! am ^greeter "Alice"))

(test-equal "Hello Bob, my name is Alice!"
  (actormap-peek am alice "Bob"))

(define (^gregarious _bcom my-name)
  (lambda (talk-to)
    (format #f "I heard back: ~a"
            ($ talk-to my-name))))

(define greg
  (actormap-spawn! am ^gregarious "Greg"))

;; Actors which call other actors
(test-equal "I heard back: Hello Greg, my name is Alice!"
  (actormap-peek am greg alice))

;; Actor updates: update and return value separately
(define* (^cell bcom #:optional [val #f])
  (case-lambda
    [() val]
    [(new-val) (bcom (^cell bcom new-val))]))

(actormap-run!
 am
 (lambda ()
   (define cell (spawn ^cell))
   (test-equal ($ cell) #f)                  ; initial val
   (test-equal ($ cell 'foo) *unspecified*)  ; update (no return value)
   (test-equal ($ cell) 'foo)))              ; new val

;; Actor updates: update and return value at same time
(define* (^counter bcom #:optional [n 0])
  (lambda ()
    (bcom (^counter bcom (1+ n)) n)))

(actormap-run!
 am
 (lambda ()
   (define ctr (spawn ^counter))
   (test-equal 0 ($ ctr))
   (test-equal 1 ($ ctr))
   (test-equal 2 ($ ctr))
   (test-equal 3 ($ ctr))))

;; Now for some noncommittal stuff.

;; Let's noncommittally spawn our friend here...
(define-values (greety greety-tm)
  (actormap-spawn am ^greeter "Greety"))
;; We should be able to use actormap-peek on the transactormap...
(test-equal (actormap-peek greety-tm greety "Marge")
  "Hello Marge, my name is Greety!")
;; But we shouldn't be able to act on greety against the uncommitted
;; actormap, because nothing happened there...
(test-error #t (actormap-peek am greety "Marge"))
;; But now let's commmit it...
(transactormap-merge! greety-tm)
;; And now we should be able to.
(test-equal (actormap-peek am greety "Marge")
  "Hello Marge, my name is Greety!")

;; Test that peek and poke work right
(define a-ctr (actormap-spawn! am ^counter))
(test-equal (actormap-peek am a-ctr) 0)
(test-equal (actormap-peek am a-ctr) 0)
(test-equal (actormap-poke! am a-ctr) 0)
(test-equal (actormap-poke! am a-ctr) 1)
(test-equal (actormap-peek am a-ctr) 2)
(test-equal (actormap-peek am a-ctr) 2)
(test-equal (actormap-poke! am a-ctr) 2)
(test-equal (actormap-peek am a-ctr) 3)


(test-end "test-goblins-stage2")
