bug#40681: srfi-18 mutex-unlock! breaks mutex on timeout

[d4ryus]

hi,

when mutex-unlock! is called (master: module/srfi/srfi-18.scm +306) with
a condition and a timeout, it first resets the owner and then waits for
the condition. If the timeout is reached
(threads:wait-condition-variable returns #f) the cond's else condition
returns #f. Now the owner is #f, which prevents one from unlocking the
mutex, due to the early return if owner is #f.

Reproducer (also attached to the email):

  (use-modules (srfi srfi-18))
  
  (let ((condition (make-condition-variable))
        (mutex (make-mutex))
        (timeout (seconds->time
                  (+ (time->seconds (current-time)) 1)))) ;; 1 second timeout
    (mutex-lock! mutex)
    (when (mutex-unlock! mutex condition timeout)
      ;; Mutex is unlocked, everything is fine. This is not reached
      ;; though, as nobody signals the condition
      (error "Not reached"))
    ;; Timeout was reached
    ;; Now the mutex has no owner but is stilled locked
    ;; Calling mutex-unlock! has no effect
    (mutex-unlock! mutex)
    ;; And a call to lock will now block forever
    (mutex-lock! mutex))

This affects guile 2.2 and master.

A fix would be to only reset the owner when the mutex is truly unlocked,
e.g. something along the lines of (also attached to the email):

  diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
  index 79aedb8d1..7da6254d4 100644
  --- a/module/srfi/srfi-18.scm
  +++ b/module/srfi/srfi-18.scm
  @@ -307,17 +307,19 @@ object (absolute point in time), or #f."
                           (timeout %unlock-sentinel))
     (let ((timeout (timeout->absolute-time timeout)))
       (when (mutex-owner mutex)
  -      (set-mutex-owner! mutex #f)
         (cond
          ((eq? cond-var %unlock-sentinel)
  +        (set-mutex-owner! mutex #f)
           (threads:unlock-mutex (mutex-prim mutex)))
          ((eq? timeout %unlock-sentinel)
           (threads:wait-condition-variable (condition-variable-prim cond-var)
                                            (mutex-prim mutex))
  +        (set-mutex-owner! mutex #f)
           (threads:unlock-mutex (mutex-prim mutex)))
          ((threads:wait-condition-variable (condition-variable-prim cond-var)
                                            (mutex-prim mutex)
                                            timeout)
  +        (set-mutex-owner! mutex #f)
           (threads:unlock-mutex (mutex-prim mutex)))
          (else #f)))))


If you need any additional information let me know.

Thanks for your great work!

- d4ryus

reproducer.scm
Description: Lotus Screencam

potential-fix.patch
Description: Text document