#1696: mutex-lock! doesn't always lock mutex

[Chicken Trac]

#1696: mutex-lock! doesn't always lock mutex
-------------------------------------+-------------------------------------
            Reporter:  megane        |       Type:  defect
              Status:  new           |   Priority:  major
           Milestone:  someday       |  Component:  unknown
             Version:  5.2.0         |   Keywords:  srfi-69 mutex race
Estimated difficulty:  insane        |  threads scheduler
-------------------------------------+-------------------------------------
 {{{
 ;; From C4 tests/mutex-test.scm
 (import scheme)
 (cond-expand
  (chicken-5 (import (chicken base)
                     (chicken type)
                     (chicken format)
                     srfi-18))
  (else (import chicken) (use srfi-18)))

 (define-record-printer (mutex x out)
   (format out "<mutex ~a ~a~a ~a (owner ~a) waiting ~a>"
           (mutex-name x)
           (if (##sys#slot x 5) "LOCKED" "FREE")
           (if (##sys#slot x 4) "/ABANDONED" "")
           (mutex-state x)
           (if (##sys#slot x 2) (##sys#slot x 2) "none")
           (##sys#slot x 3)
           ))

 (let ((m1 (make-mutex)))
   ;; (print m1)
   (mutex-lock! m1)
   (print m1)
   (print* "l")
   ;; (thread-sleep! 0.001)
   (let ((t1 (thread-start! (lambda ()
                              (print* "t")
                              (mutex-lock! m1 0.001)
                              (print "\noh no, we got the mutex")
                              (print m1)
                              (exit 1)))))
     (print* "y")
     (thread-yield!)
     (print* "Y")
     (when (eq? 'ready (##sys#slot t1 3)) ;; <- #3 thread state
       (print* "X")
       (thread-sleep! 1)
       (print* "Z"))))

 (print* ".")

 ;; OK run:
 ;; lytY.<mutex mutex0 LOCKED #<thread: primordial> (owner #<thread:
 primordial>) waiting ()>

 ;; Failing run:
 ;; lytYX
 ;; oh no, we got the mutex
 ;; <mutex mutex0 LOCKED #<thread: primordial> (owner #<thread:
 primordial>) waiting ()>

 }}}

-- 
Ticket URL: <https://bugs.call-cc.org/ticket/1696>
CHICKEN Scheme <https://www.call-cc.org/>
CHICKEN Scheme is a compiler for the Scheme programming language.