;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/test/rw-lock (:documentation "Test-suite for :ukkoclot/src/rw-lock.") (:use :c2cl :fiveam :iterate :ukkoclot/src/rw-lock) (:import-from :bt2 :join-thread :make-thread :with-timeout)) (in-package :ukkoclot/test/rw-lock) (def-suite :ukkoclot/rw-lock) (in-suite :ukkoclot/rw-lock) (test rw-lock.typep (is (typep (make-rw-lock) 'rw-lock))) (test rw-lock-p (is (rw-lock-p (make-rw-lock)))) (test acquire-read-lock.no-contention (with-timeout (5) (let ((lock (make-rw-lock))) (is-true (acquire-read-lock lock :wait t)) (is (rw-lock-p (release-read-lock lock))) (is-true (acquire-read-lock lock :wait nil)) (is (rw-lock-p (release-read-lock lock)))))) (test acquire-read-lock.multiple (with-timeout (5) (let ((lock (make-rw-lock))) (is-true (acquire-read-lock lock :wait t)) (is-true (acquire-read-lock lock :wait nil)) (is-true (acquire-read-lock lock :wait t)) (is (rw-lock-p (release-read-lock lock))) (is (rw-lock-p (release-read-lock lock))) (is (rw-lock-p (release-read-lock lock)))))) (test release-read-lock.failing (let ((lock (make-rw-lock))) (signals error (release-read-lock lock)) (is-true (acquire-write-lock lock :wait nil)) (signals error (release-read-lock lock)))) (test acquire-write-lock.no-contention (let ((lock (make-rw-lock))) (is-true (acquire-write-lock lock :wait nil)) (is (rw-lock-p (release-write-lock lock))) (is-true (acquire-write-lock lock :wait nil)) (is (rw-lock-p (release-write-lock lock))))) (test acquire-write-lock.contention (let ((lock (make-rw-lock))) (is-true (acquire-write-lock lock :wait nil)) (is-false (acquire-write-lock lock :wait nil)) (is (rw-lock-p (release-write-lock lock))))) (test acquire-write-lock.failing (let ((lock (make-rw-lock))) (signals error (release-write-lock lock)) (is-true (acquire-read-lock lock :wait nil)) (signals error (release-write-lock lock)))) (test acquire-read&write-lock.contention (let ((lock (make-rw-lock))) (is-true (acquire-read-lock lock :wait nil)) (is-true (acquire-read-lock lock :wait nil)) (is-false (acquire-write-lock lock :wait nil)) (is (rw-lock-p (release-read-lock lock))) (is (rw-lock-p (release-read-lock lock))) (is-true (acquire-write-lock lock :wait nil)) (is-false (acquire-read-lock lock :wait nil)) (is (rw-lock-p (release-write-lock lock))))) (test read&write-locks.contention (let ((lock (make-rw-lock)) (value 0) reader-threads writer-threads) (flet ((reader-fn () (with-read-lock (lock) (sleep (random 0.1)) value)) (writer-fn () (with-write-lock (lock) (incf value) (sleep (random 0.1)) (incf value)))) (iter (repeat 100) (push (make-thread #'reader-fn) reader-threads) (sleep (random 0.02)) (push (make-thread #'writer-fn) writer-threads))) (iter (for writer-thread in writer-threads) (join-thread writer-thread)) (is (every #'evenp (iter (for reader-thread in reader-threads) (collect (join-thread reader-thread))))))) (test with-read-lock.simple (let ((lock (make-rw-lock))) (with-read-lock (lock) (is-true (acquire-read-lock lock :wait nil)) (is (rw-lock-p (release-read-lock lock))) (is-false (acquire-write-lock lock :wait nil))) (is-true (acquire-read-lock lock :wait nil)) (is (rw-lock-p (release-read-lock lock))) (is-true (acquire-write-lock lock :wait nil)) (is (rw-lock-p (release-write-lock lock))))) (test with-write-lock.simple (let ((lock (make-rw-lock))) (with-write-lock (lock) (is-false (acquire-read-lock lock :wait nil)) (is-false (acquire-write-lock lock :wait nil))) (is-true (acquire-read-lock lock :wait nil)) (is (rw-lock-p (release-read-lock lock))) (is-true (acquire-write-lock lock :wait nil)) (is (rw-lock-p (release-write-lock lock)))))