source: project/release/5/timed-resource/trunk/tests/timed-resource-test.scm @ 38596

Last change on this file since 38596 was 38596, checked in by Kon Lovett, 6 months ago

add use-timed-resource

File size: 2.1 KB
Line 
1;;;; timed-resource-test.scm
2;;;; Kon Lovett, Mar '20
3;;;; Kon Lovett, Jun '17
4;;;; Kon Lovett, Oct '09
5
6;;;
7
8(import test)
9
10(import (only (chicken format) format))
11(include "test-gloss.incl")
12
13#; ;preferred
14(define sleeping-glossf (o glossf countdown seconds))
15
16(define (sleeping-glossf secs #!optional (fmt "Sleeping ~A secs"))
17  (import (only (srfi 18) thread-sleep!))
18  (glossnf fmt secs) (display #\return)
19  (thread-sleep! secs) )
20
21;;
22
23(test-begin "Timed Resource")
24
25(import timed-resource)
26
27;;;
28
29(import (chicken blob))
30(import (srfi 4))
31
32;;
33
34(define-syntax inc!
35  (syntax-rules ()
36    ((inc! ?loc)
37      (let ((val ?loc))
38        (set! ?loc (add1 val)) ) ) ) )
39
40(define (read-blob u8cnt #!optional (port (current-input-port)))
41  (u8vector->blob (read-u8vector u8cnt port)) )
42
43(define-constant ACTIVE-SECONDS 1.0)
44(define-constant BUFFER-BYTES 16)
45
46(define +opened+ 0)
47(define +closed+ 0)
48
49(define (timed-random-blob opener)
50  (let (
51    (+tr+
52      (make-timed-resource
53        (lambda ()
54          (let ((port (opener)))
55            (test-assert "Resource Opened" port)
56            (inc! +opened+)
57            port ) )
58        (lambda (port)
59          (close-output-port port)
60          (inc! +closed+) )
61        ACTIVE-SECONDS)) )
62    (lambda (#!optional (cnt 16))
63      ;NOTE only because used once; brittle!
64      (test-assert "Resource Cannot Be Open" (not (timed-resource-open? +tr+)))
65      (use-timed-resource (+tr+ v) (read-blob cnt v)) ) ) )
66
67;;;
68
69;; Config
70
71(cond-expand
72  (windows
73    ;;FIXME a windows file to read
74    (define (open-test-port)
75      #f ) )
76  (unix
77    (define (open-test-port)
78      (open-input-file "/dev/random" #:binary) ) ) )
79
80;; Test
81
82(test-group "Simple Timed Resource"
83
84  ;Activate the TR, once
85  (let (
86    (x ((timed-random-blob open-test-port) BUFFER-BYTES)) )
87    (test-assert "Resource Read Type" (blob? x))
88    (test "Resource Read Size" BUFFER-BYTES (blob-size x)) )
89
90  ;Wait a little longer than the timeout
91  (sleeping-glossf (+ ACTIVE-SECONDS 0.5))
92
93  ;Better be closed now!
94  (test "Resource Closed" +closed+ +opened+) )
95
96;;;
97
98
99(test-end "Timed Resource")
100
101(test-exit)
Note: See TracBrowser for help on using the repository browser.