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

Last change on this file since 38141 was 38141, checked in by Kon Lovett, 3 months ago

complexify test, fix make-... return

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