Changeset 38141 in project


Ignore:
Timestamp:
01/20/20 20:24:26 (4 weeks ago)
Author:
Kon Lovett
Message:

complexify test, fix make-... return

Location:
release/5/timed-resource/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/timed-resource/trunk/tests/timed-resource-test.scm

    r38093 r38141  
     1;;;; timed-resource-test.scm
     2
     3;;;
     4
    15(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)
    248(import (chicken blob))
    3 (import (srfi 4))
    4 (import (srfi 18))
    5 (import timed-resource)
     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
    676
    777(cond-expand
    8   (windows)
     78  (windows
     79    ;;FIXME a windows file to read
     80    (define (open-test-port)
     81      #f ) )
    982  (unix
    10     (define-constant ACTIVE-SECONDS 1.0)
     83    (define (open-test-port)
     84      (open-input-file "/dev/random" #:binary) ) ) )
    1185
    12     (define +opened+ 0) ;For Testing Only
    13     (define +closed+ 0) ;For Testing Only
     86;; Test
    1487
    15     (define random-blob
    16       (let ((tr-random-dev
    17               (make-timed-resource
    18                 (lambda ()
    19                   (set! +opened+ (add1 +opened+)) ;For Testing Only
    20                   (open-input-file "/dev/random" #:binary))
    21                 (lambda (port)
    22                   (set! +closed+ (add1 +closed+)) ;For Testing Only
    23                   (close-output-port port))
    24                 ACTIVE-SECONDS)))
    25         (lambda (#!optional (bits 128))
    26           (let ((bytes (inexact->exact (floor (/ (+ bits 7) 8)))))
    27             (with-timed-resource tr-random-dev
    28               (lambda (port)
    29                 (u8vector->blob (read-u8vector bytes port))))) ) ) )
     88(test-group "Simple Timed Resource"
    3089
    31     (test-group "Simple Timed Resource"
    32       (let ((x (random-blob)))
    33         (test-assert (blob? x))
    34         (test 16 (blob-size x)) )
    35       ;Wait a little longer than the timeout
    36       (thread-sleep! (inexact->exact (round (+ ACTIVE-SECONDS 0.5))))
    37       ;Better be closed now!
    38       (test "Resource Closed" +closed+ +opened+) ) ) )
     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;;;
    39102
    40103(test-exit)
  • release/5/timed-resource/trunk/timed-resource.egg

    r38093 r38141  
    22
    33((synopsis "Resource w/ Timeout")
    4  (version "2.0.0")
     4 (version "2.0.1")
    55 (category misc)
    66 (author "[[kon lovett]]")
  • release/5/timed-resource/trunk/timed-resource.scm

    r38093 r38141  
    220220  (and x (check-positive-number 'default-timed-resource-timeout x))))
    221221
    222 (: make-timed-resource (procedure procedure number #!optional * --> timed-resource))
     222(: make-timed-resource (procedure procedure number #!optional * -> timed-resource))
    223223;
    224224(define (make-timed-resource opener closer timeout #!optional (name 'timed-resource))
    225   (unless (or +shutdown?+ (thread-reaper-shutdown?)) ;Shouldn't be necessary
     225  (and
     226    (not (or +shutdown?+ (thread-reaper-shutdown?))) ;Shouldn't be necessary
    226227    (%make-timed-resource
    227228      (check-procedure 'make-timed-resource opener 'open-procedure)
    228229      (check-procedure 'make-timed-resource closer 'close-procedure)
    229       (check-number 'make-timed-resource timeout 'timeout)
     230      (check-positive-number 'make-timed-resource timeout 'timeout)
    230231      (make-mutex (make-timed-resource-name name))
    231232      #f #f) ) )
     233
     234#; ;uhh
     235(define-syntax use-timed-resource
     236  (syntax-rules ()
     237    ((use-timed-resource (?tr ?v) ?body ...)
     238      (let ((tr (check-timed-resource 'use-timed-resource ?tr)))
     239        (record-synch tr timed-resource
     240          (let ((?v (timed-resource-aquire tr)))
     241            ?body ...) ) ) ) ) )
    232242
    233243(: with-timed-resource (timed-resource procedure -> void))
Note: See TracChangeset for help on using the changeset viewer.