From d8a52af2520d14035fc3a36a7aa3569f9856380a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 8 Oct 2023 11:29:21 +0200
Subject: Further rewrite of testrunner.

Move many of the atomic procedures into proper libraries.
---
 tests/unit/coverage-supplement.scm | 13 +++++++++++++
 tests/unit/util/atomic-queue.scm   | 32 ++++++++++++++++++++++++++++++++
 tests/unit/util/atomic-stack.scm   | 25 +++++++++++++++++++++++++
 3 files changed, 70 insertions(+)
 create mode 100644 tests/unit/coverage-supplement.scm
 create mode 100644 tests/unit/util/atomic-queue.scm
 create mode 100644 tests/unit/util/atomic-stack.scm

(limited to 'tests')

diff --git a/tests/unit/coverage-supplement.scm b/tests/unit/coverage-supplement.scm
new file mode 100644
index 00000000..9fb2f6d6
--- /dev/null
+++ b/tests/unit/coverage-supplement.scm
@@ -0,0 +1,13 @@
+;;; Guile's coverage system sometimes miss some definitions.
+;;; Add these here so the output gets green.
+;;; However, always start by attempting to add more tests to fill
+;;; in the coverage.
+;;;
+;;; Each entry in this file should be a list consisting of:
+;;; - The filename, relative calp's root
+;;; - The sha256-sum of that file
+;;; - Any number of lines which should be marked as covered.
+(("module/vcomponent/base.scm"
+  "f98a3887020c400595bcc32805f968ebebca685bc1c18ef1f1531f55d9f72ec1"
+  73 83 108 1)
+ )
diff --git a/tests/unit/util/atomic-queue.scm b/tests/unit/util/atomic-queue.scm
new file mode 100644
index 00000000..428f4457
--- /dev/null
+++ b/tests/unit/util/atomic-queue.scm
@@ -0,0 +1,32 @@
+(define-module (test atomic-queue)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-88)
+  :use-module (hnh util atomic-queue))
+
+;;; TODO multithreaded tests
+
+(define q (atomic-queue))
+
+(enqueue! 1 q)
+(enqueue! 2 q)
+(enqueue! 3 q)
+
+(test-equal 1 (dequeue! q))
+
+(enqueue! 4 q)
+
+(test-equal 2 (dequeue! q))
+(test-equal 3 (dequeue! q))
+(test-equal 4 (dequeue! q))
+(test-equal #f (dequeue! q))
+(test-equal #f (dequeue! q))
+
+(test-group "Errors are capturable"
+ (catch #t
+   (lambda ()
+     (queue-peek q)
+     (test-assert "Should never be reached" #f))
+   (lambda _ (test-assert #t "Error correctly captured"))))
+
+
+'((hnh util atomic-queue))
diff --git a/tests/unit/util/atomic-stack.scm b/tests/unit/util/atomic-stack.scm
new file mode 100644
index 00000000..46a16bfb
--- /dev/null
+++ b/tests/unit/util/atomic-stack.scm
@@ -0,0 +1,25 @@
+(define-module (test atomic-stack)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-88)
+  :use-module (hnh util atomic-stack))
+
+(define stack (atomic-stack))
+
+(test-equal "Fresh stacks are empty"
+  '() (stack->list stack))
+
+(push! 1 stack)
+(push! 2 stack)
+(push! 3 stack)
+
+(test-equal "Stack contents when content"
+  '(3 2 1) (stack->list stack))
+
+(test-equal "Poped correctly 3" 3 (pop! stack))
+(push! 4 stack)
+(test-equal "Poped correctly 4" 4 (pop! stack))
+(test-equal "Poped correctly 2" 2 (pop! stack))
+(test-equal "Poped correctly 1" 1 (pop! stack))
+(test-equal "Poped correctly #f" #f (pop! stack))
+
+'((hnh util atomic-stack))
-- 
cgit v1.2.3