Rewrite test running system.

1 files changed, 0 insertions, 408 deletions

diff --git a/tests/test/hnh-util.scm b/tests/test/hnh-util.scm
deleted file mode 100644
index c4a20443..00000000
--- a/tests/test/hnh-util.scm
+++ /dev/null
@@ -1,408 +0,0 @@
-;;; Commentary:
-;; Checks some prodecuders from (hnh util)
-;;; Code:
-
-(define-module (test hnh-util)
-  :use-module (srfi srfi-64)
-  :use-module (srfi srfi-64 test-error)
-  :use-module (srfi srfi-88)
-  :use-module (srfi srfi-1)
-  :use-module (hnh util)
-  :use-module (hnh util env)
-  )
-
-(define (unreachable)
-  (throw 'unreachable))
-
-
-;;; Changed core bindings
-
-(test-group "set!"
-  (let ((x 10))
-    (set! x 20)
-    (test-eqv "Regular set! still works" 20 x))
-
-  (test-group "Multiple set! at once works"
-    (let ((x 10) (y 20))
-      (set! x 20
-            y 30)
-      (test-eqv x 20)
-      (test-eqv y 30)))
-
-  (test-group "Set! is ordered"
-    (let ((x 10))
-      (set! x 20
-            x (* x 2))
-      (test-eqv x 40)))
-
-  ;; TODO
-  ;; (test-group "set! ="
-  ;;   )
-
-  )
-
-;;; Nonscensical to test
-;; (test-group "define-syntax"
-;;   )
-
-(test-group "Conditionals"
- (test-equal "when"
-   1 (when #t 1))
-
- (test-equal "'() when #f"
-   '() (when #f 1))
-
- (test-equal "unless"
-   1 (unless #f 1))
-
- (test-equal "'() unless #t"
-   '() (unless #t 1))
-
-
-
-;;; New bindings
-
-(test-group "aif"
-  (aif (+ 1 2)
-       (test-eqv 3 it)
-       (unreachable))
-
-  (aif #f
-       (unreachable)
-       (test-assert #t)))
-
- (test-equal "awhen it"
-   '(3 4 5)
-   (awhen (memv 2 '(1 2 3 4 5))
-          (cdr it)))
-
- (test-equal "awhen not"
-   '()
-   (awhen (memv 0 '(1 2 3 4 5))
-          (cdr it))))
-
-(test-group "for"
- (test-equal "for simple"
-   (iota 10)
-   (for x in (iota 10)
-        x))
-
- (test-equal "for matching"
-   (iota 12)
-   (for (x c) in (zip (iota 12) (string->list "Hello, World"))
-        x))
-
- (test-equal "for with improper list elements"
-   `(3 7)
-   (for (a . b) in '((1 . 2) (3 . 4))
-        (+ a b)))
-
- (test-equal "for with longer improper list elements"
-   '(1 2 4)
-   (for (a b . c) in '((1 -1 . 1) (2 -2 . 2) (4 -4 . 4))
-        (* c (+ 1 a b))))
-
- (test-equal "for break"
-   'x
-   (for x in (iota 10)
-        (break 'x)
-        (test-assert "This should never happen" #f)))
-
- (test-equal "for continue"
-   '(x #f 2)
-   (for x in (iota 3)
-        (case x
-          ((0)
-           (continue 'x)
-           (test-assert "Continue with value failed" #f))
-          ((1)
-           (continue)
-           (test-assert "Continue without value failed" #f))
-          (else x)))))
-
-
-(test-group "print-and-return"
-  (let ((p (open-output-string)))
-    (let ((v (with-error-to-port p
-               (lambda () (print-and-return (+ 1 2))))))
-      (test-equal "Printed value"
-        "3 [(+ 1 2)]\n" (get-output-string p))
-      (test-eqv "Returned value"
-        3 v))))
-
-(test-group "swap"
-  (test-equal
-      '(3 2 1)
-    ((swap list) 1 2 3)))
-
-
-(test-equal "procedure label"
-  120
-  ((label factorial (lambda (n)
-                      (if (zero? n)
-                          1 (* n (factorial (1- n))))))
-   5))
-
-;; we can't test if sort*! destroys the list, since its only /allowed/ to do it,
-;; not required.
-(test-equal "sort*!"
-  '("a" "Hello" "Assparagus")
-  (sort*! '("Hello" "a" "Assparagus")
-          < string-length))
-
-
-
-
-
-
-(test-assert "not equal"
-  (!= 1 2))
-
-(test-equal "Take to"
-  '() (take-to '() 5))
-
-(test-group "string-take-to"
-  (test-equal "Hello"
-    (string-take-to "Hello, World!" 5)))
-
-(test-group "string-first"
-  (test-eqv #\H (string-first "Hello, World!")))
-
-(test-group "string-last"
-  (test-eqv #\! (string-last "Hello, World!")))
-
-(test-group "as-symb"
-  (test-eq "From string" 'hello (as-symb "hello"))
-  (test-eq "From symbol" 'hello (as-symb 'hello))
-  (test-eq "NOTE that others pass right through"
-    '() (as-symb '())))
-
-
-(test-equal "Enumerate"
-  '((0 #\H) (1 #\e) (2 #\l) (3 #\l) (4 #\o) (5 #\,) (6 #\space) (7 #\W) (8 #\o) (9 #\r) (10 #\l) (11 #\d) (12 #\!))
-  (enumerate (string->list "Hello, World!")))
-
-(test-equal "unval first"
-  1
-  ((unval (lambda () (values 1 2 3)))))
-
-(test-equal "unval other"
-  2
-  ((unval car+cdr 1)
-   (cons 1 2)))
-
-(test-group "Flatten"
- (test-equal "flatten already flat"
-   (iota 10)
-   (flatten (iota 10)))
-
- (test-equal "flatten really deep"
-   '(1)
-   (flatten '(((((((((((((((1)))))))))))))))))
-
- (test-equal "flatten mixed"
-   '(1 2 3 4 5)
-   (flatten '((((((1(((((2((((3))))))4))))))))5))))
-
-;; TODO test let-lazy
-
-(test-group "map/dotted"
-  (test-equal "map/dotted without dot"
-    '(1 2 3 4)
-    (map/dotted 1+ '(0 1 2 3)))
-
-  (test-equal "map/dotted with dot"
-    '(1 2 3 . 4)
-    (map/dotted 1+ '(0 1 2 . 3)))
-
-  (test-equal "map/dotted direct value"
-    1 (map/dotted 1+ 0)))
-
-
-
-(test-group "group-by"
-  ;; Extra roundabout tests since groups-by doesn't guarantee order of the keys
-  (test-group "Two simple groups"
-    (let ((groups (group-by even? (iota 10))))
-      (test-assert (lset= eq? '(#f #t) (map car groups)))
-      (test-assert (lset= = '(0 2 4 6 8) (assq-ref groups #t)))
-      (test-assert (lset= = '(1 3 5 7 9) (assq-ref groups #f)))))
-
-  (test-group "Identity groups"
-    (let ((groups (group-by identity (iota 5))))
-      (test-assert "Correct keys"
-        (lset= = (iota 5) (map car groups)))
-      (test-group "Correct amount in each group"
-        (for-each (lambda (g) (test-equal 1 (length (cdr g)))) groups))))
-
-  (test-equal "Null case"
-    '()
-    (group-by (lambda _ (unreachable)) '())))
-
-(test-group "split-by"
-  'TODO)
-
-
-
-(test-group "cross-product"
-  (test-equal "Basic case"
-      '((1 4)
-        (1 5)
-        (1 6)
-        (2 4)
-        (2 5)
-        (2 6)
-        (3 4)
-        (3 5)
-        (3 6))
-   (cross-product
-    '(1 2 3)
-    '(4 5 6)))
-
-  (test-equal "Single input list"
-    '((1) (2) (3))
-    (cross-product '(1 2 3)))
-
-  (test-equal "More than two"
-    '((1 3 5) (1 3 6)
-      (1 4 5) (1 4 6)
-      (2 3 5) (2 3 6)
-      (2 4 5) (2 4 6))
-    (cross-product
-     '(1 2)
-     '(3 4)
-     '(5 6))))
-
-(test-group "Arrows"
-  (test-equal "->" 9 (-> 1 (+ 2) (* 3)))
-  (test-equal "-> order dependant" -1 (-> 1 (- 2)))
-  (test-equal "->> order dependant" 1 (->> 1 (- 2))))
-
-;; TODO set and set->
-
-;; TODO and=>>
-
-;; downcase-symbol
-
-
-
-;; TODO test failure when grouping isn't possible?
-(test-equal "Group"
-  '((0 1) (2 3) (4 5) (6 7) (8 9))
-  (group (iota 10) 2))
-
-;; TODO test failure when grouping isn't possible?
-
-(test-group "Associations"
-  (test-equal "assoc-ref-all" '(1 3) (assoc-ref-all '((a . 1) (b . 2) (a . 3)) 'a))
-  (test-equal "assq-ref-all" '(1 3) (assq-ref-all '((a . 1) (b . 2) (a . 3)) 'a))
-  (test-equal "assv-ref-all" '(1 3) (assv-ref-all '((a . 1) (b . 2) (a . 3)) 'a))
-
-  ;; TODO assq-limit ?
-
-  (test-equal "assq merge"
-    '((k 2 1) (v 2))
-    (assq-merge '((k 1) (v 2)) '((k 2))))
-
-  (test-equal "kvlist->assq"
-    '((a . 1) (b . 2))
-    (kvlist->assq '(a: 1 b: 2)))
-
-
-  (test-equal "kvlist->assq repeated key"
-    '((a . 1) (b . 2) (a . 3))
-    (kvlist->assq '(a: 1 b: 2 a: 3))))
-
-(test-equal "vector-last"
-  1 (vector-last #(0 2 3 1)))
-
-;; TODO test catch*
-
-(test-equal
-  "Filter sorted"
-  '(3 4 5)
-  (filter-sorted (lambda (x) (<= 3 x 5)) (iota 10)))
-
-(test-equal
-  "set/r! = single"
-  #f
-  (let ((x #t)) (set/r! x = not)))
-
-(test-error
-  'syntax-error
-  (test-read-eval-string "(set/r! x err not)"))
-
-(test-group "Find extremes"
-  (test-error 'wrong-type-arg (find-extreme '()))
-
-  (test-group "find-min"
-   (call-with-values
-       (lambda () (find-min (iota 10)))
-     (lambda (extreme rest)
-       (test-equal "Found correct minimum" 0 extreme)
-       (test-equal
-           "Removed \"something\" from the set"
-         9
-         (length rest)))))
-
-  (test-group "find-max"
-   (call-with-values
-       (lambda ()
-         (find-max
-          '("Hello" "Test" "Something long")
-          string-length))
-     (lambda (extreme rest)
-       (test-equal
-           "Found the longest string"
-         "Something long"
-         extreme)
-       (test-equal "Removed the string" 2 (length rest))
-       (test-assert
-           "Other members left 1"
-         (member "Hello" rest))
-       (test-assert
-           "Other members left 2"
-         (member "Test" rest))))))
-
-(test-group "Span upto"
-  (test-group "Case 1"
-   (call-with-values
-       (lambda ()
-         (span-upto
-          2
-          char-numeric?
-          (string->list "123456")))
-     (lambda (head tail)
-       (test-equal '(#\1 #\2) head)
-       (test-equal '(#\3 #\4 #\5 #\6) tail))))
-
-  (test-group "Case 2"
-   (call-with-values
-       (lambda ()
-         (span-upto
-          2
-          char-numeric?
-          (string->list "H123456")))
-     (lambda (head tail)
-       (test-equal '() head)
-       (test-equal '(#\H #\1 #\2 #\3 #\4 #\5 #\6) tail)))))
-
-(test-group "Begin1"
-  (let ((value #f))
-    (test-equal
-        "begin1 return value"
-      "Hello"
-      (begin1 "Hello" (set! value "World")))
-    (test-equal "begin1 side effects" "World" value))
-
-  (let ((x 1))
-    (test-eqv "begin1 set! after return"
-      1 (begin1 x (set! x 10)))
-    (test-eqv "Updates value"
-      10 x)))
-
-(test-equal 0 (iterate 1- zero? 10))
-
-(test-group "->string"
-  (test-equal "5" (->string 5))
-  (test-equal "5" (->string "5")))