/quick-test/quick-test.reds
Unknown | 224 lines | 200 code | 24 blank | 0 comment | 0 complexity | 6b41779bae2a62222d0b2529fb24c63e MD5 | raw file
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