Changeset 39731 in project


Ignore:
Timestamp:
03/17/21 00:21:00 (5 weeks ago)
Author:
Kon Lovett
Message:

test cursor w/ unlimited/limited/unbuffered

Location:
release/5/mailbox/trunk/tests
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/mailbox/trunk/tests/mailbox-cursor-test.scm

    r39724 r39731  
    77;;; Test support
    88
    9 (define-constant MESSAGE-LIMIT 5)
     9;(define-constant MESSAGE-LIMIT 5)
     10(define-constant MESSAGE-LIMIT 3)
    1011
    11 (define-constant TIMEOUT #;0.5 0.25)
     12;(define-constant TIMEOUT 4)    ;slow but otherwise ok
     13;(define-constant TIMEOUT 0.5)
     14(define-constant TIMEOUT 0.25)
    1215
    1316(define (current-thread-name) (thread-name (current-thread)))
     
    3942;;
    4043
    41 (let ((mailbox-one (make-unlimited-mailbox 'one)))
     44(define (test-mailbox-one knd mb1 lmt tmo)
    4245
    4346  (define (writer-thread-body)
    4447    (thread-labeled-print "Started!")
    4548    (let loop ((cnt 0))
    46       (thread-sleep! TIMEOUT)
    47       (if (= MESSAGE-LIMIT cnt)
    48         (mailbox-send! mailbox-one (makmsg 'quit))
     49      (thread-sleep! tmo)
     50      (if (= lmt cnt)
     51        (mailbox-send! mb1 (makmsg 'quit))
    4952        (let ((msg (makmsg cnt)))
    5053          (thread-labeled-print "Send! at " (current-seconds) " sec")
    51           (mailbox-send! mailbox-one msg)
     54          (mailbox-send! mb1 msg)
    5255          (loop (add1 cnt))) ) ) )
    5356
     
    5558    (lambda ()
    5659      (thread-labeled-print "Started!")
    57       (let ((mbc (make-mailbox-cursor mailbox-one)))
     60      (let ((mbc (make-mailbox-cursor mb1)))
    5861        (let loop ()
    5962          (let ((msg (mailbox-cursor-next mbc)))
     
    8487
    8588  (newline)
    86   (print "** Test mailbox-cursor **")
    87   (print "Message Limit = " MESSAGE-LIMIT " Timeout = " TIMEOUT " seconds")
     89  (print "** Test Mailbox " knd " Cursor **")
     90  (print "Message Limit = " lmt " Timeout = " tmo " seconds")
    8891  (newline)
    8992
     
    98101  (thread-join! reader-thread-two) )
    99102
     103(test-mailbox-one "Unlimited"   (make-unlimited-mailbox 'unlimited-one) MESSAGE-LIMIT TIMEOUT)
     104(test-mailbox-one "Limited"     (make-limited-mailbox 1 'limited-one) MESSAGE-LIMIT TIMEOUT)
     105(test-mailbox-one "Unbuffered"  (make-unbuffered-mailbox 'unbuffered-one) MESSAGE-LIMIT TIMEOUT)
     106
    100107(newline)
    101108
  • release/5/mailbox/trunk/tests/reader-writer-test.scm

    r39724 r39731  
    9595
    9696(test-mailbox-one "Unlimited"   (make-unlimited-mailbox 'unlimited-one) MESSAGE-LIMIT TIMEOUT)
    97 (test-mailbox-one "Limited"     (make-limited-mailbox 3 'limited-one) MESSAGE-LIMIT TIMEOUT)
     97(test-mailbox-one "Limited"     (make-limited-mailbox 1 'limited-one) MESSAGE-LIMIT TIMEOUT)
    9898(test-mailbox-one "Unbuffered"  (make-unbuffered-mailbox 'unbuffered-one) MESSAGE-LIMIT TIMEOUT)
    9999
Note: See TracChangeset for help on using the changeset viewer.