hans/uni-channel
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

sync tested.

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-08 14:21:36 +02:00
parent 78f4583b6d
commit f0c4f5a4ce
6 changed files with 331 additions and 427 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/main.rkt
+81 -48
View File
@@ -1,65 +1,98 @@
#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)
(test-case "single async channel"
(define ch (make-uni-async-channel #:name 'single))
(check-true (uni-channel? ch))
(check-equal? (uni-channel-kind ch) 'async)
(uni-channel-put ch 'hello)
(check-equal? (uni-channel-get ch) 'hello)
(check-false (uni-channel-try-get ch))
(sync (uni-channel-put-evt ch 'via-evt))
(check-equal? (sync ch) 'via-evt)
(uni-channel-close ch)
(check-true (uni-channel-closed? ch))
(check-exn exn:fail? (lambda () (uni-channel-put ch 'after-close))))
(define (not-exported? name)
(with-handlers ([exn:fail? (lambda (_e) #t)])
(dynamic-require 'uni-channel name)
#f))
(test-case "async channel pair"
(define-values (a b) (make-uni-async-channel-pair))
(uni-channel-send a '(from a))
(uni-channel-send b '(from b))
(check-equal? (uni-channel-recv b) '(from a))
(check-equal? (uni-channel-recv a) '(from b)))
(define tests
(test-suite
"uni-channel"
(test-case "place channel pair"
(define-values (a b) (make-uni-place-channel-pair))
(uni-channel-send a '(place a))
(check-equal? (uni-channel-recv b) '(place a))
(uni-channel-send b '(place b))
(check-equal? (sync a) '(place b)))
(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 "port channel over pipe"
(define-values (in out) (make-pipe))
(define ch (make-uni-port-channel #:input in #:output out #:source 'pipe-test #:name 'pipe))
(check-equal? (uni-channel-kind ch) 'port)
(check-equal? (uni-channel-direction ch) 'bidirectional)
(uni-channel-put ch '(hello 1 2 3))
(uni-channel-put ch (msg 7 '(a b c)))
(check-equal? (uni-channel-get ch) '(hello 1 2 3))
(check-equal? (uni-channel-get ch) (msg 7 '(a b c)))
(uni-channel-close ch)
(check-true (uni-channel-closed? ch))
(check-true (eof-object? (uni-channel-get ch))))
(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)
(check-true (uni-channel-closed? ch))
(check-exn exn:fail? (lambda () (uni-channel-put ch 'after-close))))
(test-case "wrap existing port-channel endpoints"
(define-values (in out) (make-pipe))
(define reader (make-port-channel in #:source 'reader))
(define writer (make-port-channel out #:source 'writer))
(define in-ch (make-uni-channel reader #:name 'reader))
(define out-ch (make-uni-channel writer #:name 'writer))
(check-equal? (uni-channel-direction in-ch) 'input)
(check-equal? (uni-channel-direction out-ch) 'output)
(uni-channel-put out-ch 'wrapped)
(check-equal? (uni-channel-get in-ch) 'wrapped)
(uni-channel-close out-ch)
(check-true (eof-object? (uni-channel-get in-ch))))
(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)
(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"))