2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
|
(string-intersperse
(map (lambda (x)
(number->string x 16))
(map string->number
(string-split instr)))
"/"))
(define (common:faux-lock keyname #!key (wait-time 8))
(if (rmt:no-sync-get/default keyname #f) ;; do not be tempted to compare to pid. locking is a one-shot action, if already locked for this pid it doesn't actually count
(if (> wait-time 0)
(begin
(thread-sleep! 1)
(if (eq? wait-time 1) ;; only one second left, steal the lock
(begin
(debug:print-info 0 *default-log-port* "stealing lock for " keyname)
|
>
>
>
>
>
>
|
|
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
|
(string-intersperse
(map (lambda (x)
(number->string x 16))
(map string->number
(string-split instr)))
"/"))
;;======================================================================
;; L O C K I N G M E C H A N I S M S
;;======================================================================
;; faux-lock is deprecated. Please use simple-lock below
;;
(define (common:faux-lock keyname #!key (wait-time 8)(allow-lock-steal #t))
(if (rmt:no-sync-get/default keyname #f) ;; do not be tempted to compare to pid. locking is a one-shot action, if already locked for this pid it doesn't actually count
(if (> wait-time 0)
(begin
(thread-sleep! 1)
(if (eq? wait-time 1) ;; only one second left, steal the lock
(begin
(debug:print-info 0 *default-log-port* "stealing lock for " keyname)
|
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
|
(define (common:faux-unlock keyname #!key (force #f))
(if (or force (equal? (conc (current-process-id)) (conc (rmt:no-sync-get/default keyname #f))))
(begin
(if (rmt:no-sync-get/default keyname #f) (rmt:no-sync-del! keyname))
#t)
#f))
(define (common:in-running-test?)
(and (args:get-arg "-execute") (get-environment-variable "MT_CMDINFO")))
(define (common:get-color-from-status status)
(cond
((equal? status "PASS") "green")
((equal? status "FAIL") "red")
|
>
>
>
>
|
>
>
>
>
|
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
|
(define (common:faux-unlock keyname #!key (force #f))
(if (or force (equal? (conc (current-process-id)) (conc (rmt:no-sync-get/default keyname #f))))
(begin
(if (rmt:no-sync-get/default keyname #f) (rmt:no-sync-del! keyname))
#t)
#f))
;; simple lock. improve and converge on this one.
;;
(define (common:simple-lock keyname)
(rmt:no-sync-get-lock keyname))
;;======================================================================
;;
;;======================================================================
(define (common:in-running-test?)
(and (args:get-arg "-execute") (get-environment-variable "MT_CMDINFO")))
(define (common:get-color-from-status status)
(cond
((equal? status "PASS") "green")
((equal? status "FAIL") "red")
|