Changeset 18789 in project for release/4/pool/trunk/tests/run.scm


Ignore:
Timestamp:
07/10/10 23:48:03 (10 years ago)
Author:
Moritz Heidkamp
Message:

pool: use a condition variable instead of sleep intervals to signal when locks are freed to waiting threads and bump version to 0.2

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/pool/trunk/tests/run.scm

    r18621 r18789  
    2121
    2222
    23 (test 'foo (call-with-value-from-pool pool
    24              (lambda (v)
    25                (thread-join! (call-with-value-from-pool-in-thread pool
    26                                (lambda (v)
    27                                  (thread-join! (call-with-value-from-pool-in-thread pool
    28                                                  (lambda (v)
    29                                                    (thread-join! (call-with-value-from-pool-in-thread pool identity)))))))))))
     23(test "returning false from the proc" #f (call-with-value-from-pool pool (constantly #f)))
     24
     25(test-error "deadlock"
     26            (let ((pool (make-pool '(a))))
     27              (call-with-value-from-pool pool
     28                (lambda (v)
     29                  (thread-join!
     30                   (call-with-value-from-pool-in-thread pool identity))))))
     31(let* ((value 0)
     32       (pool (make-pool '(1))))
     33  (for-each (lambda (i)
     34              (call-with-value-from-pool-in-thread pool
     35                (lambda (v)
     36                  (set! value (add1 value)))))
     37            (list-tabulate 10 (constantly 1)))
     38
     39  (let loop ((threads (##sys#all-threads)))
     40    (unless (null? threads)
     41      (thread-join! (car threads))
     42      (loop (##sys#all-threads))))
     43
     44  (test 10 value))
     45
     46
     47;; this one is left to fail - it needs dynamic-wind to be fixed but I couldn't make it work so far
     48(let ((jump #f)
     49      (done #f))
     50
     51  (call-with-value-from-pool pool
     52    (lambda (v)
     53      (call/cc (lambda (c)
     54                 (set! jump c)))
     55
     56      (when done
     57        (test "value is still locked" 'foo (alist-ref (current-thread) (pool-locked-values pool))))))
     58 
     59  (unless done
     60    (set! done #t)
     61    (call-with-value-from-pool-in-thread pool (lambda (v) (thread-suspend! (current-thread))))
     62    (jump #t)))
Note: See TracChangeset for help on using the changeset viewer.