aboutsummaryrefslogtreecommitdiff
path: root/tests/test/util.scm
blob: 325ca99264db9ed6449ca484ef4e298430f28009 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
;;; Commentary:
;; Checks some prodecuders from (hnh util)
;;; Code:

(define-module (test util)
  :use-module (srfi srfi-64)
  :use-module (srfi srfi-64 test-error)
  :use-module (srfi srfi-88)
  :use-module ((hnh util)
               :select (filter-sorted
                        set/r!
                        find-min
                        find-max
                        find-extreme
                        span-upto
                        iterate
                        ->string
                        ->quoted-string
                        begin1))
  :use-module ((hnh util path)
               :select (path-append path-split)))

(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)"))

(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))))

(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-error 'wrong-type-arg (find-extreme '()))

(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)))

(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)))

(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-equal "5" (->string 5))

(test-equal "5" (->string "5"))

(test-equal "5" (->quoted-string 5))

(test-equal "\"5\"" (->quoted-string "5"))

(test-equal
  "no slashes"
  "home/user"
  (path-append "home" "user"))

(test-equal
  "no slashes, absolute"
  "/home/user"
  (path-append "" "home" "user"))

(test-equal
  "slashes in one component, absolute"
  "/home/user"
  (path-append "" "/home/" "user"))

(test-equal
  "slashes in one component, absolute due to first"
  "/home/user"
  (path-append "/home/" "user"))

(test-equal
  "Slashes in both"
  "home/user"
  (path-append "home/" "/user"))

(test-equal "root" "/" (path-append ""))

(test-equal
  '("usr" "lib" "test")
  (path-split "usr/lib/test"))

(test-equal
  '("usr" "lib" "test")
  (path-split "usr/lib/test/"))

(test-equal
  '("" "usr" "lib" "test")
  (path-split "/usr/lib/test"))

(test-equal
  '("" "usr" "lib" "test")
  (path-split "//usr////lib/test"))