|
|
|
;;; Copyright 2022 Edward L. Platt
|
|
|
|
;;;
|
|
|
|
;;; 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 (tests test-preference)
|
|
|
|
#:use-module (srfi srfi-64)
|
|
|
|
#:use-module (goblins)
|
|
|
|
#:use-module (goblins vrun)
|
|
|
|
#:use-module (goblins actor-lib methods)
|
|
|
|
#:use-module (deliberate preference))
|
|
|
|
|
|
|
|
(test-begin "test-deliberate-preference")
|
|
|
|
|
|
|
|
(define a-vat (spawn-vat))
|
|
|
|
(define-vat-run a-run a-vat)
|
|
|
|
|
|
|
|
;; Tests for ^alternatives
|
|
|
|
(define question "What type of generator should we install?")
|
|
|
|
(define alts (a-run (spawn ^alternatives question '("solar" "wind"))))
|
|
|
|
|
|
|
|
(test-equal "What type of generator should we install?"
|
|
|
|
(a-run ($ alts 'question)))
|
|
|
|
|
|
|
|
(test-equal '("solar" "wind")
|
|
|
|
(a-run ($ alts 'alternatives)))
|
|
|
|
|
|
|
|
(a-run ($ alts 'add "hydro"))
|
|
|
|
|
|
|
|
(test-equal '("hydro" "solar" "wind")
|
|
|
|
(a-run ($ alts 'alternatives)))
|
|
|
|
|
|
|
|
|
|
|
|
;; Tests for ^ranked-preference
|
|
|
|
(define alternatives
|
|
|
|
(a-run (spawn ^alternatives
|
|
|
|
question
|
|
|
|
'("solar" "wind" "hydro"))))
|
|
|
|
(define (f1 alts) '(1 2 3))
|
|
|
|
(define (f2 alts) '(2 3 1))
|
|
|
|
|
|
|
|
(define pref (a-run (spawn ^ranked-preference alternatives)))
|
|
|
|
|
|
|
|
(test-equal '()
|
|
|
|
(a-run ($ pref 'ranked)))
|
|
|
|
|
|
|
|
(test-equal #f
|
|
|
|
(a-run ($ pref 'rank-of "solar")))
|
|
|
|
|
|
|
|
(a-run ($ pref 'set f1))
|
|
|
|
|
|
|
|
(test-equal 1
|
|
|
|
(a-run ($ pref 'rank-of "solar")))
|
|
|
|
|
|
|
|
(test-equal 3
|
|
|
|
(a-run ($ pref 'rank-of "hydro")))
|
|
|
|
|
|
|
|
(test-equal #f
|
|
|
|
(a-run ($ pref 'rank-of "wildgoose")))
|
|
|
|
|
|
|
|
(a-run ($ pref 'set f2))
|
|
|
|
|
|
|
|
(test-equal 1
|
|
|
|
(a-run ($ pref 'rank-of "hydro")))
|
|
|
|
|
|
|
|
|
|
|
|
;; Tests for ^ranked-profile
|
|
|
|
(define profile (a-run (spawn ^ranked-profile alternatives)))
|
|
|
|
(define pref1 (a-run ($ profile 'add-preference)))
|
|
|
|
|
|
|
|
(test-equal '()
|
|
|
|
(a-run ($ pref1 'ranked)))
|
|
|
|
|
|
|
|
(define pref2 (a-run ($ profile 'add-preference)))
|
|
|
|
(a-run ($ pref1 'set f1))
|
|
|
|
(a-run ($ pref2 'set f2))
|
|
|
|
|
|
|
|
(define counts (a-run ($ profile 'counts)))
|
|
|
|
|
|
|
|
(test-equal '((1 . ("hydro" "solar" "wind"))
|
|
|
|
(1 . ("solar" "wind" "hydro")))
|
|
|
|
counts)
|
|
|
|
|
|
|
|
(test-end "test-deliberate-preference")
|