7 files changed, 267 insertions, 1 deletions

diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
index f30fd61..e2f455c 100644
--- a/.pre-commit-config.yaml
+++ b/.pre-commit-config.yaml
@@ -9,6 +9,11 @@ repos:
     entry: ocicl lint
     pass_filenames: true
     files: \.(lisp|asd)$
+  - id: run-testsuite
+    name: run-testsuite
+    language: system
+    entry: ./run-tests.sh
+    pass_filenames: false
 - repo: https://github.com/fsfe/reuse-tool
   rev: v6.1.2
   hooks:
diff --git a/ocicl.csv b/ocicl.csv
index ecc65f6..44ae424 100644
--- a/ocicl.csv
+++ b/ocicl.csv
@@ -36,6 +36,7 @@ fast-http, ghcr.io/ocicl/fast-http@sha256:44e98b5239c0ded4921dc0b04ae272cff00583
 fast-http-test, ghcr.io/ocicl/fast-http@sha256:44e98b5239c0ded4921dc0b04ae272cff00583d93797a657543db782979eb50c, fast-http-20240503-2232fc9/fast-http-test.asd
 fast-io, ghcr.io/ocicl/fast-io@sha256:7ba35a0eddf00b3c25656b3c5a93e95460f6cb8f807afbc04ef4f50076d95aff, fast-io-20240503-a4c5ad6/fast-io.asd
 fast-io-test, ghcr.io/ocicl/fast-io@sha256:7ba35a0eddf00b3c25656b3c5a93e95460f6cb8f807afbc04ef4f50076d95aff, fast-io-20240503-a4c5ad6/fast-io-test.asd
+fiveam, ghcr.io/ocicl/fiveam@sha256:e283043dc8d31e8df2b214465cf5a06ea07bdbea10e600a40e17aaf9518226ac, fiveam-20240928-e43d6c8/fiveam.asd
 flexi-streams, ghcr.io/ocicl/flexi-streams@sha256:95005b06a8a95c82780c75ead53810bcb273d07fcf5fe76b527f1856df9923f2, flexi-streams-20240503-4951d57/flexi-streams.asd
 flexi-streams-test, ghcr.io/ocicl/flexi-streams@sha256:95005b06a8a95c82780c75ead53810bcb273d07fcf5fe76b527f1856df9923f2, flexi-streams-20240503-4951d57/flexi-streams-test.asd
 float-features, ghcr.io/ocicl/float-features@sha256:64922efd92a08670cf8292ea56dfff29c577d36d8a7f7576cea0c031805c52d2, float-features-20250813-cd5dab0/float-features.asd
@@ -60,6 +61,7 @@ log4cl-examples, ghcr.io/ocicl/log4cl@sha256:bd33f6e5ad346892e852492e7101bc18d26
 log4cl.log4slime, ghcr.io/ocicl/log4cl@sha256:bd33f6e5ad346892e852492e7101bc18d263f9ef2ba6192178568d1b20337112, log4cl-20240503-fe3da51/log4cl.log4slime.asd
 log4cl.log4sly, ghcr.io/ocicl/log4cl@sha256:bd33f6e5ad346892e852492e7101bc18d263f9ef2ba6192178568d1b20337112, log4cl-20240503-fe3da51/log4cl.log4sly.asd
 multilang-documentation-utils, ghcr.io/ocicl/documentation-utils@sha256:b2a1b3f3bcd1a738af85ae2b0168d408c177661eab6d6bbebb254e394d983f54, documentation-utils-20230511-98630dd/multilang-documentation-utils.asd
+net.didierverna.asdf-flv, ghcr.io/ocicl/net.didierverna.asdf-flv@sha256:e5cd087d41cf24302a92d9bac426a925f8868b554be2414c0f012c961e3ddb8c, asdf-flv-20240503-3f1de41/net.didierverna.asdf-flv.asd
 parse-declarations-1.0, ghcr.io/ocicl/parse-declarations-1.0@sha256:9305fa9624205b16fd1fc51cb1cc4282a18e50eee9ac75b66a14f6f2c5df9518, parse-declarations-20240503-549aebb/parse-declarations-1.0.asd
 parse-number, ghcr.io/ocicl/parse-number@sha256:11f3f9f512871e1f96cea6b8260aa3610e34e8fd7272bbcdb210fd3c5dd8025c, parse-number-20240503-cb9e487/parse-number.asd
 proc-parse, ghcr.io/ocicl/proc-parse@sha256:0880f9acb35eb9efbe1f77a981e36e84e8f29a22b14f680c7686eb381fa87bd6, proc-parse-20240503-3afe2b7/proc-parse.asd
@@ -89,6 +91,8 @@ trivia.ppcre, ghcr.io/ocicl/trivia@sha256:51db74757bc31ceaf3a643914a8ffa87825799
 trivia.quasiquote, ghcr.io/ocicl/trivia@sha256:51db74757bc31ceaf3a643914a8ffa87825799097dea4912650e6ac62bed5209, trivia-20240904-4383dd8/trivia.quasiquote.asd
 trivia.test, ghcr.io/ocicl/trivia@sha256:51db74757bc31ceaf3a643914a8ffa87825799097dea4912650e6ac62bed5209, trivia-20240904-4383dd8/trivia.test.asd
 trivia.trivial, ghcr.io/ocicl/trivia@sha256:51db74757bc31ceaf3a643914a8ffa87825799097dea4912650e6ac62bed5209, trivia-20240904-4383dd8/trivia.trivial.asd
+trivial-backtrace, ghcr.io/ocicl/trivial-backtrace@sha256:89a3138695bb767c50001402fad60dacfc1e867e4e3d3579cc6f636d3e29a51c, trivial-backtrace-20240503-7f90b4a/trivial-backtrace.asd
+trivial-backtrace-test, ghcr.io/ocicl/trivial-backtrace@sha256:89a3138695bb767c50001402fad60dacfc1e867e4e3d3579cc6f636d3e29a51c, trivial-backtrace-20240503-7f90b4a/trivial-backtrace-test.asd
 trivial-cltl2, ghcr.io/ocicl/trivial-cltl2@sha256:69470b4f6469314799074b9d944050dc4bcb67d5cbb2ba32c7a8899bb492f04e, trivial-cltl2-20230809-2ada872/trivial-cltl2.asd
 trivial-features, ghcr.io/ocicl/trivial-features@sha256:e278e24d39060fc7d3715531b16ddd9ab7f93f22ade53e436c0b86dbae3aa065, trivial-features-1.0/trivial-features.asd
 trivial-features-tests, ghcr.io/ocicl/trivial-features@sha256:e278e24d39060fc7d3715531b16ddd9ab7f93f22ade53e436c0b86dbae3aa065, trivial-features-1.0/trivial-features-tests.asd
diff --git a/run-tests.sh b/run-tests.sh
new file mode 100755
index 0000000..f8338b3
--- /dev/null
+++ b/run-tests.sh
@@ -0,0 +1,12 @@
+#!/bin/sh
+# SPDX-License-Identifier: EUPL-1.2
+# SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+
+set -eu
+
+exec sbcl \
+     --disable-ldb --lose-on-corruption \
+     --noinform --noprint --non-interactive \
+     --eval '(asdf:load-system :ukkoclot/test/all)' \
+     --eval '(setf ukkoclot/test/all:*should-quit* t)' \
+     --eval '(asdf:test-system :ukkoclot)'
diff --git a/src/rw-lock.lisp b/src/rw-lock.lisp
new file mode 100644
index 0000000..b32d3d0
--- /dev/null
+++ b/src/rw-lock.lisp
@@ -0,0 +1,136 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/src/rw-lock
+  (:documentation "Implementation of a shared/read-write lock.")
+  (:use :c2cl :bt2 :iterate)
+  (:import-from :alexandria :with-gensyms)
+  (:import-from :com.dieggsy.f-string :enable-f-strings)
+  (:import-from :sb-sys
+   :allow-with-interrupts :with-local-interrupts :without-interrupts)
+  (:export
+   #:rw-lock
+   #:rw-lock-p
+   #:make-rw-lock
+   #:acquire-read-lock
+   #:release-read-lock
+   #:with-read-lock
+   #:acquire-write-lock
+   #:release-write-lock
+   #:with-write-lock))
+(in-package :ukkoclot/src/rw-lock)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (enable-f-strings))
+
+;; TODO: Get rid of broadcasting for writers, instead have separate condvars
+;; TODO: Make it a bit more fair, 50% chance of waking up writers or readers
+;; TODO: Use atomic-integer in best-case for read locks to decrease contention
+(defstruct (rw-lock (:constructor make-rw-lock%))
+  (lock nil :type lock :read-only t)
+  (unlocked nil :type condition-variable :read-only t)
+  (readers 0 :type integer)
+  (has-writer nil :type boolean))
+
+(defvar *counter-lock* (make-lock :name "rw-lock::*counter-lock*"))
+
+(defvar *counter* 0)
+
+(defun gen-name ()
+  (format nil "Read-Write Lock ~A"
+          (with-lock-held (*counter-lock*)
+            (incf *counter*))))
+
+(defun make-rw-lock (&key (name (gen-name)))
+  (check-type name string)
+  (make-rw-lock%
+   :lock (make-lock :name #f"{name}'s internal lock")
+   :unlocked (make-condition-variable :name #f"{name}'s internal unlocked")))
+
+(defun acquire-read-lock (rw-lock &key (wait t))
+  ;; TODO: timeout
+  (check-type rw-lock rw-lock)
+  (with-slots (lock unlocked readers has-writer) rw-lock
+    (let ((lock-acquired))
+      (without-interrupts
+        (unwind-protect
+             (when (setf lock-acquired
+                         (allow-with-interrupts
+                          (acquire-lock lock :wait wait)))
+               (with-local-interrupts
+                 (when (if wait
+                           (iter
+                             (unless has-writer
+                               (return t))
+                             (condition-wait unlocked lock))
+                           (not has-writer))
+                   (incf readers)
+                   t)))
+          (when lock-acquired
+            (release-lock lock)))))))
+
+(defun release-read-lock (rw-lock)
+  (check-type rw-lock rw-lock)
+  (with-slots (lock unlocked readers has-writer) rw-lock
+    (with-lock-held (lock)
+      (decf readers)
+      (when (zerop readers)
+        (condition-broadcast unlocked))))
+  rw-lock)
+
+(defmacro with-read-lock ((rw-lock) &body body)
+  ;; TODO: timeout
+  (with-gensyms (lock-acquired lock-value)
+    `(let ((,lock-acquired)
+           (,lock-value ,rw-lock))
+       (without-interrupts
+         (unwind-protect
+              (when (setf ,lock-acquired
+                          (allow-with-interrupts
+                           (acquire-read-lock ,lock-value)))
+                (with-local-interrupts ,@body))
+           (when ,lock-acquired
+             (release-read-lock ,lock-value)))))))
+
+(defun acquire-write-lock (rw-lock &key (wait t))
+  ;; TODO: timeout
+  (check-type rw-lock rw-lock)
+  (with-slots (lock unlocked readers has-writer) rw-lock
+    (let ((lock-acquired))
+      (without-interrupts
+        (unwind-protect
+             (when (setf lock-acquired
+                         (allow-with-interrupts
+                           (acquire-lock lock :wait wait)))
+               (with-local-interrupts
+                 (when (if wait
+                           (iter
+                             (unless (or (> readers 0) has-writer)
+                               (return t))
+                             (condition-wait unlocked lock))
+                           (and (zerop readers) (not has-writer)))
+                   (setf has-writer t)
+                   t)))
+          (when lock-acquired
+            (release-lock lock)))))))
+
+(defun release-write-lock (rw-lock)
+  (check-type rw-lock rw-lock)
+  (with-slots (lock unlocked readers has-writer) rw-lock
+    (with-lock-held (lock)
+      (setf has-writer nil)
+      (condition-broadcast unlocked)))
+  rw-lock)
+
+(defmacro with-write-lock ((rw-lock) &body body)
+  ;; TODO: timeout
+  (with-gensyms (lock-acquired lock-value)
+    `(let ((,lock-acquired)
+           (,lock-value ,rw-lock))
+       (without-interrupts
+         (unwind-protect
+              (when (setf ,lock-acquired
+                          (allow-with-interrupts
+                            (acquire-write-lock ,lock-value)))
+                (with-local-interrupts ,@body))
+           (when ,lock-acquired
+             (release-write-lock ,lock-value)))))))
diff --git a/test/all.lisp b/test/all.lisp
new file mode 100644
index 0000000..b0a731b
--- /dev/null
+++ b/test/all.lisp
@@ -0,0 +1,28 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/test/all
+  (:documentation "Main test runner package.")
+  (:use :c2cl :fiveam
+   :ukkoclot/test/rw-lock)
+  (:import-from :bt2 :with-timeout)
+  (:import-from :uiop)
+  (:export #:*should-quit* #:run-tests))
+(in-package :ukkoclot/test/all)
+
+(defvar *should-quit* nil
+  "Bind as true if `run-tests' should exit the process with 0 or 1.
+
+Useful for CI.")
+
+;; TODO: Maybe I should signal on failure instead :thinking:
+(defun run-tests ()
+  "Run all tests"
+  (with-timeout (100)
+    (let ((status (run-all-tests)))
+      (when *should-quit*
+        (format t "~2&BTW Ignore the fatal ERROR condition below")
+        (cond
+          (status (format t "~&!GREAT SUCCESS!~2%")
+                  (uiop:quit 0))
+          (t (format t "~&!!! TESTS R FUCKED MATE !!!~2%")
+             (uiop:quit 1)))))))
diff --git a/test/rw-lock.lisp b/test/rw-lock.lisp
new file mode 100644
index 0000000..4460398
--- /dev/null
+++ b/test/rw-lock.lisp
@@ -0,0 +1,79 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/test/rw-lock
+  (:documentation "Test-suite for :ukkoclot/src/rw-lock.")
+  (:use :c2cl :fiveam :ukkoclot/src/rw-lock)
+  (:import-from :bt2 :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 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-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 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)))))
diff --git a/ukkoclot.asd b/ukkoclot.asd
index fd7f14e..339a208 100644
--- a/ukkoclot.asd
+++ b/ukkoclot.asd
@@ -11,11 +11,13 @@
   :description "ukkoclot: Ukko's shitty telegram bot"
   :long-description #.(uiop:read-file-string (uiop:subpathname *load-pathname* "README.md"))
   :depends-on (:ukkoclot/src/main)
-  ;; TODO: :in-order-to ((test-op (test-op ukkoclot-test)))
+  :in-order-to ((test-op (load-op :ukkoclot/test/all)))
+  :perform (test-op (o c) (symbol-call :ukkoclot/test/all :run-tests)))
 
 (register-system-packages :ukkoclot/src/config '(:conf))
 (register-system-packages :ukkoclot/src/main '(:ukkoclot))
 
+(register-system-packages :bordeaux-threads '(:bt2))
 (register-system-packages :closer-mop '(:c2cl))
 (register-system-packages :dexador '(:dex))
 (register-system-packages :log4cl '(:log))