Changeset 40458 in project


Ignore:
Timestamp:
09/08/21 17:44:17 (2 weeks ago)
Author:
Kon Lovett
Message:

reaper-timeout proc type, reflow, new test runner

Location:
release/5/thread-utils/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/5/thread-utils/trunk/tests/run.scm

    r39825 r40458  
    77    make-pathname pathname-file pathname-replace-directory pathname-strip-extension)
    88  (only (chicken process) system)
    9   (only (chicken process-context) command-line-arguments)
     9  (only (chicken process-context) command-line-arguments get-environment-variable)
    1010  (only (chicken format) format)
    1111  (only (chicken file) file-exists? find-files)
     
    1313
    1414;; Globals
     15
     16(define *csi* (or (get-environment-variable "CHICKEN_CSI") "csi"))
     17(define *csc* (or (get-environment-variable "CHICKEN_CSC") "csc"))
    1518
    1619(define *csc-init-options* '(
     
    7982
    8083(define (run-test-evaluated source)
    81   (format #t "*** csi ~A ***~%" (pathname-file source))
    82   (system-must (string-append "csi -s " source)) )
     84  (format #t "*** ~A ~A ***~%" *csi* (pathname-file source))
     85  (system-must (string-append *csi* " -s " source)) )
    8386
    8487(define (run-test-compiled source csc-options)
    8588  (let ((optstr (apply string-append (intersperse csc-options " "))))
    86     (format #t "*** csc ~A ~A ***~%" (pathname-file source) optstr)
     89    (format #t "*** ~A ~A ~A ***~%" *csc* (pathname-file source) optstr)
    8790    ;csc output is in current directory
    88     (system-must (string-append "csc" " " optstr " " source)) )
     91    (system-must (string-append *csc* " " optstr " " source)) )
    8992  (system-must (pathname-replace-directory (pathname-strip-extension source) *test-directory*)) )
    9093
  • release/5/thread-utils/trunk/thread-reaper.scm

    r38939 r40458  
    2525  thread-reaper-stop!
    2626  ;
    27   thread-reaper-greedy thread-reaper-greedy-set!
    28   thread-reaper-quantum thread-reaper-quantum-set!
    29   thread-reaper-wait-seconds thread-reaper-wait-seconds-set!
    30   thread-reaper-timeout thread-reaper-timeout-set!
    31   thread-reaper-retries thread-reaper-retries-set!)
    32 
    33 (import scheme)
    34 (import (chicken base))
    35 (import (chicken type))
    36 (import (only (chicken condition) handle-exceptions))
    37 (import (only queues queue-empty? queue-remove! make-queue queue-add! queue->list))
    38 (import (only (srfi 18) thread-name thread-sleep! thread-join! thread-yield!
    39   thread-start! make-thread thread-quantum-set! thread-quantum
    40   terminated-thread-exception? uncaught-exception?))
    41 (import (only miscmacros until))
    42 (import (only synch-object make-synch-with-object))
    43 (import (prefix (only synch-dyn synch-with) dyn:))
    44 (import (only synch-open %synch-with))
    45 (import (only record-variants define-record-type-variant))
    46 (import (only thread-utils check-thread print-exception-warning))
    47 (import (only type-checks check-positive-number check-natural-fixnum))
     27  thread-reaper-greedy
     28  thread-reaper-quantum
     29  thread-reaper-wait-seconds
     30  thread-reaper-timeout
     31  thread-reaper-retries
     32  thread-reaper-greedy-set!
     33  thread-reaper-quantum-set!
     34  thread-reaper-wait-seconds-set!
     35  thread-reaper-timeout-set!
     36  thread-reaper-retries-set!)
     37
     38(import scheme
     39  (chicken base)
     40  (chicken type)
     41  (only (chicken condition) handle-exceptions)
     42  (only queues queue-empty? queue-remove! make-queue queue-add! queue->list)
     43  (only (srfi 18) thread-name thread-sleep! thread-join! thread-yield!
     44    thread-start! make-thread thread-quantum-set! thread-quantum
     45    terminated-thread-exception? uncaught-exception?)
     46  (only miscmacros until)
     47  (only synch-object make-synch-with-object)
     48  (prefix (only synch-dyn synch-with) dyn:)
     49  (only synch-open %synch-with)
     50  (only record-variants define-record-type-variant)
     51  (only thread-utils check-thread print-exception-warning)
     52  (only type-checks check-positive-number check-natural-fixnum))
    4853
    4954;;
     
    5459(: thread-reaper-stop! (-> void))
    5560(: thread-reaper-greedy (-> boolean))
     61(: thread-reaper-quantum (-> fixnum))
     62(: thread-reaper-wait-seconds (-> number))
     63(: thread-reaper-timeout (-> number))
     64(: thread-reaper-retries (-> fixnum))
    5665(: thread-reaper-greedy-set! (boolean -> void))
    57 (: thread-reaper-quantum (-> fixnum))
    5866(: thread-reaper-quantum-set! (fixnum -> void))
    59 (: thread-reaper-wait-seconds (-> number))
    6067(: thread-reaper-wait-seconds-set! (number -> void))
    61 (: thread-reaper-timeout (-> number))
    6268(: thread-reaper-timeout-set! (number -> void))
    63 (: thread-reaper-retries (-> fixnum))
    6469(: thread-reaper-retries-set! (fixnum -> void))
    6570
     
    234239;;
    235240
    236 ;"location" style calling
    237 
    238241(define (thread-reaper-greedy-set! flag) (set! *greedy?* (->boolean flag)))
    239 
    240 (define thread-reaper-greedy
    241   (getter-with-setter
    242     (lambda args *greedy?*)
    243      thread-reaper-greedy-set!))
    244242
    245243(define (thread-reaper-quantum-set! qt)
    246244  (unless *reaper-thread* (error 'thread-reaper-quantum-set! "reaper is not running"))
    247245  (unless (thread-reaper-shutdown?) (thread-quantum-set! *reaper-thread* qt)) )
     246
     247(define (thread-reaper-wait-seconds-set! to)
     248  (set! *wait-seconds* (check-positive-number 'thread-reaper-wait-seconds to)) )
     249
     250(define (thread-reaper-timeout-set! to)
     251  (set! *timeout* (and to (check-positive-number 'thread-reaper-timeout to))) )
     252
     253(define (thread-reaper-retries-set! rt)
     254  (set! *retries* (check-natural-fixnum 'thread-reaper-retries rt)) )
     255
     256;;
     257
     258;"location" style calling
     259
     260(define thread-reaper-greedy
     261  (getter-with-setter
     262    (lambda args *greedy?*)
     263     thread-reaper-greedy-set!))
    248264
    249265(define thread-reaper-quantum
     
    254270    thread-reaper-quantum-set!))
    255271
    256 (define (thread-reaper-wait-seconds-set! to)
    257   (set! *wait-seconds* (check-positive-number 'thread-reaper-wait-seconds to)) )
    258 
    259272(define thread-reaper-wait-seconds
    260273  (getter-with-setter
     
    262275    thread-reaper-wait-seconds-set!))
    263276
    264 (define (thread-reaper-timeout-set! to)
    265   (set! *timeout* (and to (check-positive-number 'thread-reaper-timeout to))) )
    266 
    267277(define thread-reaper-timeout
    268278  (getter-with-setter
     
    270280    thread-reaper-timeout-set!))
    271281
    272 (define (thread-reaper-retries-set! rt)
    273   (set! *retries* (check-natural-fixnum 'thread-reaper-retries rt)) )
    274 
    275282(define thread-reaper-retries
    276283  (getter-with-setter
  • release/5/thread-utils/trunk/thread-utils.egg

    r39930 r40458  
    22
    33((synopsis "Thread Utilities")
    4  (version "2.1.1")
     4 (version "2.1.2")
    55 (category misc)
    66 (author "Kon Lovett")
  • release/5/thread-utils/trunk/thread-utils.scm

    r38939 r40458  
    7070  *thread-recipients)
    7171
    72 (import scheme)
    73 (import (chicken base))
    74 (import (chicken type))
    75 (import (only (chicken condition) print-error-message))
    76 (import (only (chicken format) format))
    77 (import (only (srfi 1) any))
    78 (import (only (srfi 18) thread-state thread? current-thread condition-variable?
    79   mutex? time? seconds->time time->seconds current-time))
    80 (import (only type-checks define-check+error-type))
     72(import scheme
     73  (chicken base)
     74  (chicken type)
     75  (only (chicken condition) print-error-message)
     76  (only (chicken format) format)
     77  (only (srfi 1) any)
     78  (only (srfi 18) thread-state thread? current-thread condition-variable?
     79    mutex? time? seconds->time time->seconds current-time)
     80  (only type-checks define-check+error-type))
    8181
    8282;;
Note: See TracChangeset for help on using the changeset viewer.