/quick-test/quick-test.reds

  1Red/System [
  2	Title:   "Red/System simple testing framework"
  3	Author:  "Peter W A Wood"
  4	File: 	 %quick-test.reds
  5	Version: 0.4.2
  6	Tabs:	 4
  7	Rights:  "Copyright (C) 2011-2015 Peter W A Wood. All rights reserved."
  8	License: "BSD-3 - https://github.com/red/red/blob/master/BSD-3-License.txt"
  9]
 10
 11;; allocate string memory
 12qt-run-name:    "123456789012345678901234567890"
 13qt-file-name:   "123456789012345678901234567890"
 14qt-group-name:  "123456789012345678901234567890"
 15qt-test-name:   "123456789012345678901234567890"
 16
 17;; counters
 18qt-run: declare struct! [
 19  tests     [integer!]
 20  asserts   [integer!]
 21  passes    [integer!]
 22  failures  [integer!]
 23]
 24qt-file: declare struct! [
 25  tests     [integer!]
 26  asserts   [integer!]
 27  passes    [integer!]
 28  failures  [integer!]
 29]
 30;; group switches
 31qt-group-name-not-printed: true
 32qt-group?: false
 33
 34_qt-init-group: does [
 35  
 36  qt-group-name-not-printed: true
 37  qt-group?: false
 38  qt-group-name: ""
 39]
 40
 41qt-init-run: func [] [
 42  qt-run/tests:     0
 43  qt-run/asserts:   0
 44  qt-run/passes:    0
 45  qt-run/failures:  0
 46  _qt-init-group
 47]
 48
 49qt-init-file: func [] [
 50  qt-file/tests:     0
 51  qt-file/asserts:   0
 52  qt-file/passes:    0
 53  qt-file/failures:  0
 54  _qt-init-group
 55]
 56
 57***start-run***: func[
 58    title [c-string!]
 59][
 60  qt-init-run
 61  qt-run-name: title
 62  print ["***Starting*** " title lf lf]
 63]
 64
 65~~~start-file~~~: func [
 66  title [c-string!]
 67][
 68  qt-init-file
 69  print ["~~~started test~~~ " title lf]
 70  qt-file-name: title
 71  qt-group?: false
 72]
 73
 74===start-group===: func [
 75  title [c-string!]
 76][
 77  qt-group-name: title
 78  qt-group?: true
 79]
 80
 81--test--: func [
 82  title [c-string!]
 83][
 84  qt-test-name: title
 85  qt-file/tests: qt-file/tests + 1
 86]
 87
 88--assert: func [
 89  assertion [logic!]
 90][
 91  qt-file/asserts: qt-file/asserts + 1
 92  
 93  either assertion [
 94     qt-file/passes: qt-file/passes + 1
 95  ][
 96    qt-file/failures: qt-file/failures + 1
 97    if qt-group? [  
 98      if qt-group-name-not-printed [
 99        print [lf "===group=== " qt-group-name lf]
100        qt-group-name-not-printed: false
101      ]
102    ]
103    print ["--test-- " qt-test-name " FAILED**************" lf]
104  ]
105]
106
107--assertf~=: func[
108  x           [float!]
109  y           [float!]
110  e           [float!]
111  /local
112    diff      [float!]
113    e1        [float!]
114    e2        [float!]
115][
116  ;; calculate tolerance to use
117  ;;    as e * max (1, x, y)
118  either x > 0.0 [
119    e1: x * e
120  ][
121    e1: -1.0 * x * e
122  ]
123  if e > e1 [e1: e]
124  either y > 0.0 [
125    e2: y * e
126  ][
127    e2: -1.0 * y * e
128  ]
129  if e1 > e2 [e2: e1]
130  
131  ;; perform almost equal check
132  either x > y [
133    diff: x - y
134  ][
135    diff: y - x
136  ]
137  either diff > e2 [
138    --assert false
139  ][
140    --assert true
141  ]
142]
143
144--assertf32~=: func[
145  x           [float32!]
146  y           [float32!]
147  e           [float32!]
148  /local
149    diff      [float32!]
150    e1        [float32!]
151    e2        [float32!]
152][
153  ;; calculate tolerance to use
154  ;;    as e * max (1, x, y)
155  either x > as float32! 0.0 [
156    e1: x * e
157  ][
158    e1: as float32! -1.0 * x * e
159  ]
160  if e > e1 [e1: e]
161  either y > as float32! 0.0 [
162    e2: y * e
163  ][
164    e2: as float32! -1.0 * y * e
165  ]
166  if e1 > e2 [e2: e1]
167  
168  ;; perform almost equal check
169  either x > y [
170    diff: x - y
171  ][
172    diff: y - x
173  ]
174  either diff > e2 [
175    --assert false
176  ][
177    --assert true
178  ]
179]
180
181 
182===end-group===: func [] [
183  _qt-init-group
184]
185
186~~~end-file~~~: func [] [
187  print ["~~~finished test~~~ " qt-file-name lf]
188  qt-print-totals qt-file/tests
189                  qt-file/asserts
190                  qt-file/passes 
191                  qt-file/failures
192  print lf
193  
194  ;; update run totals
195  qt-run/passes: qt-run/passes + qt-file/passes
196  qt-run/asserts: qt-run/asserts + qt-file/asserts
197  qt-run/failures: qt-run/failures + qt-file/failures
198  qt-run/tests: qt-run/tests + qt-file/tests
199]
200
201***end-run***: func [][
202  print ["***Finished*** " qt-run-name lf]
203  qt-print-totals qt-run/tests
204                  qt-run/asserts
205                  qt-run/passes
206                  qt-run/failures
207]
208
209qt-print-totals: func [
210  tests     [integer!]
211  asserts   [integer!]
212  passes    [integer!]
213  failures  [integer!]
214][
215  print ["  Number of Tests Performed:      " tests lf]
216  print ["  Number of Assertions Performed: " asserts lf]
217  print ["  Number of Assertions Passed:    " passes lf]
218  print ["  Number of Assertions Failed:    " failures lf]
219  if failures <> 0 [
220    print ["****************TEST FAILURES****************" lf]
221  ]
222]
223
224