101 lines
3.9 KiB
Racket
101 lines
3.9 KiB
Racket
#lang racket/base
|
|
|
|
(require rackunit
|
|
rackunit/text-ui
|
|
racket/async-channel
|
|
racket/place
|
|
racket/serialize
|
|
port-channel
|
|
uni-channel)
|
|
|
|
(serializable-struct msg (id payload) #:transparent)
|
|
|
|
(define (not-exported? name)
|
|
(with-handlers ([exn:fail? (lambda (_e) #t)])
|
|
(dynamic-require 'uni-channel name)
|
|
#f))
|
|
|
|
(define tests
|
|
(test-suite
|
|
"uni-channel"
|
|
|
|
(test-case "public API has one constructor"
|
|
(check-true (procedure? make-uni-channel))
|
|
(check-true (not-exported? 'make-uni-async-channel))
|
|
(check-true (not-exported? 'make-uni-async-channel-pair))
|
|
(check-true (not-exported? 'make-uni-place-channel))
|
|
(check-true (not-exported? 'make-uni-place-channel-pair))
|
|
(check-true (not-exported? 'make-uni-port-channel)))
|
|
|
|
(test-case "async-channel wrapper"
|
|
(define ch (make-uni-channel (make-async-channel)))
|
|
(check-true (uni-channel? ch))
|
|
(check-equal? (uni-channel-kind ch) 'async)
|
|
(check-equal? (uni-channel-direction ch) 'bidirectional)
|
|
(check-false (uni-channel-try-get ch))
|
|
(uni-channel-put ch 'hello)
|
|
(check-equal? (uni-channel-get ch) 'hello)
|
|
(sync (uni-channel-put-evt ch 'via-evt))
|
|
(check-equal? (sync ch) 'via-evt)
|
|
(uni-channel-put ch '(sync returns this value))
|
|
(check-equal? (sync (uni-channel-get-evt ch)) '(sync returns this value))
|
|
(uni-channel-close ch)
|
|
(uni-channel-wait ch)
|
|
(check-true (uni-channel-closed? ch))
|
|
(check-exn exn:fail? (lambda () (uni-channel-put ch 'after-close))))
|
|
|
|
(test-case "two async-channel wrappers can form a pair explicitly"
|
|
(define a-in (make-async-channel))
|
|
(define b-in (make-async-channel))
|
|
(define a (make-uni-channel a-in))
|
|
(define b (make-uni-channel b-in))
|
|
(uni-channel-send a 'local-a)
|
|
(uni-channel-send b 'local-b)
|
|
(check-equal? (uni-channel-recv a) 'local-a)
|
|
(check-equal? (uni-channel-recv b) 'local-b))
|
|
|
|
(test-case "place-channel wrapper"
|
|
(define-values (raw-a raw-b) (place-channel))
|
|
(define a (make-uni-channel raw-a))
|
|
(define b (make-uni-channel raw-b))
|
|
(check-equal? (uni-channel-kind a) 'place)
|
|
(check-equal? (uni-channel-direction a) 'bidirectional)
|
|
(uni-channel-send a '(from a))
|
|
(check-equal? (uni-channel-recv b) '(from a))
|
|
(uni-channel-send b '(from b))
|
|
(check-equal? (sync a) '(from b))
|
|
(uni-channel-send b '(place sync value))
|
|
(check-equal? (sync (uni-channel-get-evt a)) '(place sync value)))
|
|
|
|
(test-case "port-channel wrappers"
|
|
(define-values (in out) (make-pipe))
|
|
(define reader (make-uni-channel (make-port-channel in #:source 'reader)))
|
|
(define writer (make-uni-channel (make-port-channel out #:source 'writer)))
|
|
(check-equal? (uni-channel-kind reader) 'port)
|
|
(check-equal? (uni-channel-direction reader) 'input)
|
|
(check-equal? (uni-channel-direction writer) 'output)
|
|
(check-eq? (uni-channel-get-evt writer) never-evt)
|
|
(check-false (sync/timeout 0 writer))
|
|
(uni-channel-put writer '(hello 1 2 3))
|
|
(uni-channel-put writer (msg 7 '(a b c)))
|
|
(check-equal? (uni-channel-get reader) '(hello 1 2 3))
|
|
(check-equal? (uni-channel-get reader) (msg 7 '(a b c)))
|
|
(uni-channel-put writer (msg 9 '(via sync)))
|
|
(check-equal? (sync reader) (msg 9 '(via sync)))
|
|
(uni-channel-put writer '(via get-evt))
|
|
(check-equal? (sync (uni-channel-get-evt reader)) '(via get-evt))
|
|
(check-exn exn:fail? (lambda () (uni-channel-get writer)))
|
|
(check-exn exn:fail? (lambda () (uni-channel-put reader 'nope)))
|
|
(uni-channel-close writer)
|
|
(uni-channel-wait writer)
|
|
(check-true (uni-channel-closed? writer))
|
|
(check-true (eof-object? (uni-channel-get reader))))
|
|
|
|
(test-case "bad input"
|
|
(check-exn exn:fail? (lambda () (make-uni-channel 'not-a-channel))))))
|
|
|
|
(module+ main
|
|
(define failed (run-tests tests))
|
|
(unless (zero? failed) (exit 1))
|
|
(displayln "uni-channel tests ok"))
|