From 52c4b64e4edb6e5a2d943fccfc67fd3597147de6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 16 Oct 2023 19:41:14 +0200
Subject: Add tests for (hnh util type)

---
 tests/unit/util/hnh-util-type.scm | 44 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)
 create mode 100644 tests/unit/util/hnh-util-type.scm

diff --git a/tests/unit/util/hnh-util-type.scm b/tests/unit/util/hnh-util-type.scm
new file mode 100644
index 00000000..276af268
--- /dev/null
+++ b/tests/unit/util/hnh-util-type.scm
@@ -0,0 +1,44 @@
+(define-module (test hnh-util-type)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-64 test-error)
+  :use-module (srfi srfi-88)
+  :use-module (hnh util type))
+
+;;; NOTE current-procedure-name is more or less unstentable
+;;; Since it is so dependant on how things are evaluated.
+
+(test-assert "Basic positive test"
+  (typecheck 1 integer?))
+(test-error "Basic negative test"
+  'wrong-type-arg (typecheck 1 string?))
+
+(test-assert "Basic compound test"
+  (typecheck (cons 1 "Hello") (pair-of integer? string?)))
+(test-assert "Basic list-of test"
+  (typecheck (iota 10) (list-of integer?)))
+(test-error "Negative list-of test"
+  'wrong-type-arg (typecheck (append (iota 10) '("10"))
+                             (list-of integer?)))
+
+(test-assert "List of pairs"
+  (typecheck '((1 . "one") (2 . "two"))
+             (list-of (pair-of integer? string?))))
+
+(test-error "Negative test for list of pairs"
+  'wrong-type-arg
+  (typecheck '((1 . "one") (2 . "two") ("three" . 3))
+             (list-of (pair-of integer? string?))))
+
+(test-assert "Basic type intersection test"
+  (typecheck 1 (and integer? positive?)))
+(test-assert "Basic type union test (alt 1)"
+  (typecheck 1 (or integer? string?)))
+(test-assert "Basic type unino test (alt 2)"
+  (typecheck "1" (or integer? string?)))
+(test-assert "Basic intersection with negative part"
+  (typecheck 1 (and integer? (not zero?))))
+(test-error "Negative test for intersection with negative part"
+  'wrong-type-arg
+  (typecheck 0 (and integer? (not zero?))))
+
+'((hnh util type))
-- 
cgit v1.2.3