Changeset 36196 in project


Ignore:
Timestamp:
08/12/18 00:32:03 (13 months ago)
Author:
Kon Lovett
Message:

wank test

File:
1 edited

Legend:

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

    r36192 r36196  
    1 ;
    2 (import (chicken condition))
     1;from caolan
    32
    4 (define (maybe-condition->list exn)
     3(import (chicken condition) (srfi 18) mailbox)
     4
     5;;
     6
     7(define (ensure-conditions-as-list exn)
    58  (or
    69    (and (condition? exn) (condition->list exn))
    710    exn) )
    811
    9 ;from caolan
     12;;
    1013
    1114(print)
    1215(print "** Test Primordial Waiting **")
    1316
    14 (import srfi-18 mailbox)
     17;;
    1518
    16 (define mbox (make-mailbox))
     19(define mbox (make-mailbox 'example))
    1720
    18 (define primordial ##sys#primordial-thread #;(current-thread))
     21(define *primordial-thread* ##sys#primordial-thread #;(current-thread))
    1922
    20 (define (tst-thd)
     23;;
     24
     25(define (test-thread)
    2126  (thread-sleep! 1)
    22   (thread-signal! primordial 'example) )
     27  (thread-signal! *primordial-thread* 'example) )
    2328
    24 (define tst-thd-1 (thread-start! tst-thd))
     29(define test-thread-1 (thread-start! test-thread))
    2530
    26 #; ;; this hangs forever and eats all my cycles (with timeout)
     31;;
     32
     33#; ;this hangs forever and eats all my cycles (with timeout)
    2734(handle-exceptions exn
    28   (print "+ wait with timeout NOT OK for primordial thread: " (maybe-condition->list exn))
     35  (print "+ wait with timeout NOT OK for primordial thread: " (ensure-conditions-as-list exn))
    2936  (mailbox-receive! mbox 4) )
    3037
    31 ;; this exits as expected with the 'example exception (no timeout)
     38;this exits as expected with the 'example exception (no timeout)
    3239(handle-exceptions exn
    33   (print "+ wait with no timeout OK for primordial thread: " (maybe-condition->list exn))
     40  (print "+ wait without timeout OK for primordial thread: " (ensure-conditions-as-list exn))
    3441  (mailbox-receive! mbox) )
     42
     43;;
     44
     45(print "** Tested Primordial Waiting **")
     46
     47(thread-join! test-thread-1)
Note: See TracChangeset for help on using the changeset viewer.