test.icl 8.6 KB
Newer Older
Camil Staps's avatar
Camil Staps committed
1 2 3
module test

import StdEnv
4

Camil Staps's avatar
Camil Staps committed
5 6 7
import Control.Monad
import Control.Monad.Identity
import Control.Monad.State
Camil Staps's avatar
Camil Staps committed
8
import Data.Error
Camil Staps's avatar
Camil Staps committed
9
import Data.Functor
10
import qualified Data.Map
Camil Staps's avatar
Camil Staps committed
11 12 13
import Data.Maybe
import System._Unsafe
import Testing.TestEvents
14
from Text import class Text(concat), instance Text String
Camil Staps's avatar
Camil Staps committed
15 16
import Text.GenJSON
import Text.GenPrint
17

Camil Staps's avatar
Camil Staps committed
18 19 20
import Regex

Start w
21
	# (ok,f,w) = sfopen "tests" FReadText w
Camil Staps's avatar
Camil Staps committed
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
	| not ok
		= abort "Failed to open test data\n"
	# (io,w) = stdio w
	# io = run_tests (read 0 f) io
	# (_,w) = fclose io w
	= w

:: TestSuite :== [TestInput]

:: TestInput
	= TRegex !Bool /* skip? */ !String
	| TInput !String
	| TMatch !Int !String
	| TNoMatch

:: TestState =
38
	{ cur_names    :: ![String]
39
	, cur_location :: !TestLocation
40 41 42 43 44 45
	, cur_skipped  :: !Bool
	, cur_regex    :: !Maybe CompiledRegex
	, cur_input    :: !String
	, cur_matches  :: ![Match]
	, cur_fails    :: ![(String,Maybe FailReason)]
	, io           :: !File
Camil Staps's avatar
Camil Staps committed
46 47
	}

Camil Staps's avatar
Camil Staps committed
48 49
tell :: !TestEvent -> State TestState ()
tell ev = modify
50
	\st=:{cur_fails,io}
Camil Staps's avatar
Camil Staps committed
51
		# io = unsafeCoerce io <<< toJSON ev <<< "\n"
52 53
		->
			{ st
54
			& cur_fails = case ev of
Camil Staps's avatar
Camil Staps committed
55
				EndEvent {name,event=Failed r}
56 57 58
					-> [(name,r):cur_fails]
					-> cur_fails
			, io = unsafeCoerce io
59 60 61 62 63
			}

// Finish previous test: send Passed event if applicable
wrap_up :: State TestState ()
wrap_up =
64
	gets id >>= \{cur_names,cur_location,cur_skipped,cur_regex,cur_fails} ->
65 66
	case cur_regex of
		Just _ | not cur_skipped ->
67
			let
68
				(event,msg) = case cur_fails of
69
					[] -> (Passed, "")
70
					_  -> (Failed (Just (FailedChildren (reverse cur_fails))), "failures")
71
				end = EndEvent
72
					{ name     = last cur_names
73
					, location = Just cur_location
74 75 76 77
					, event    = event
					, message  = msg
					}
			in
Camil Staps's avatar
Camil Staps committed
78 79 80
			tell end
		_ ->
			pure ()
Camil Staps's avatar
Camil Staps committed
81 82

run_tests :: ![(Int,TestInput)] !*File -> *File
83
run_tests input io = unsafeCoerce (evalState tests)
84 85 86 87 88 89 90 91
	{ cur_names    = []
	, cur_location = {moduleName=Nothing}
	, cur_skipped  = False
	, cur_regex    = Nothing
	, cur_input    = ""
	, cur_matches  = []
	, cur_fails    = []
	, io           = unsafeCoerce io
Camil Staps's avatar
Camil Staps committed
92
	}
93 94 95 96 97
where
	tests =
		mapM_ (uncurry run_test_input) input >>|
		wrap_up >>|
		gets \st -> st.io
Camil Staps's avatar
Camil Staps committed
98 99 100

run_test_input :: !Int !TestInput -> State TestState ()
run_test_input lineno (TRegex skip rgx) =
101
	wrap_up >>|
102 103 104 105 106 107
	let
		name = concat ["/",escape rgx,"/"]
		location = {moduleName=Just ("tests:"+++toString lineno)}
	in
	modify (\st -> {st & cur_names=[name], cur_location=location, cur_skipped=skip}) >>|
	tell (StartEvent {StartEvent | name=name, location=Just location}) >>|
Camil Staps's avatar
Camil Staps committed
108
	if skip
109
	(tell (EndEvent {name=name, location=Just location, event=Skipped, message=""}))
110
	(case compileRegex rgx of
Camil Staps's avatar
Camil Staps committed
111
		Ok rgx ->
112
			modify (\st -> {st & cur_regex=Just rgx, cur_fails=[]})
Camil Staps's avatar
Camil Staps committed
113 114 115 116 117
		Error err ->
			let
				msg = "Compilation failed: "+++err
				end = EndEvent
					{ name     = name
118
					, location = Just location
Camil Staps's avatar
Camil Staps committed
119 120 121 122
					, event    = Failed (Just (CustomFailReason msg))
					, message  = msg
					}
			in
123
			modify (\st -> {st & cur_names=[name], cur_regex=Nothing}) >>|
Camil Staps's avatar
Camil Staps committed
124
			tell end)
Camil Staps's avatar
Camil Staps committed
125
run_test_input _ (TInput s) =
126
	gets id >>= \{cur_names=names,cur_location,cur_skipped,cur_regex}
127
	| cur_skipped ->
Camil Staps's avatar
Camil Staps committed
128
		pure ()
129
	| otherwise -> case cur_regex of
Camil Staps's avatar
Camil Staps committed
130 131 132
		Nothing ->
			pure ()
		Just rgx ->
133
			let my_name = concat [last names,": ",escape s] in
Camil Staps's avatar
Camil Staps committed
134 135
			modify (\st ->
				{ st
136 137 138
				& cur_names   = [my_name,last names]
				, cur_input   = s
				, cur_matches = match rgx s
Camil Staps's avatar
Camil Staps committed
139
				}) >>|
140
			tell (StartEvent {StartEvent | name=my_name, location=Just cur_location})
Camil Staps's avatar
Camil Staps committed
141
run_test_input _ (TMatch i s) =
142
	gets id >>= \{cur_names=names=:[name:_],cur_location,cur_skipped,cur_regex,cur_input,cur_matches}
143
	| cur_skipped || isNothing cur_regex ->
Camil Staps's avatar
Camil Staps committed
144
		pure ()
Camil Staps's avatar
Camil Staps committed
145
	// TODO: this generates multiple Failed events for the same input
146
	| otherwise -> case cur_matches of
Camil Staps's avatar
Camil Staps committed
147 148 149 150
		[]
			# msg = "expected match"
			# end = EndEvent
				{ name     = name
151
				, location = Just cur_location
Camil Staps's avatar
Camil Staps committed
152 153 154
				, event    = Failed (Just (CustomFailReason msg))
				, message  = msg
				}
Camil Staps's avatar
Camil Staps committed
155
			-> tell end
Camil Staps's avatar
Camil Staps committed
156 157
		[{start,end,groups}:_]
			# match = if (i==0)
158 159
				(cur_input % (start,end))
				(maybe "<unset>" ((%) cur_input) ('Data.Map'.get (NotNamed (i-1)) groups))
Camil Staps's avatar
Camil Staps committed
160 161 162
			# (event,msg) = if (match == s)
				(Passed, "")
				(Failed (Just (FailedAssertions
163
					[ExpectedRelation (GPrint (printToString s)) Eq (GPrint (printToString match))]))
Camil Staps's avatar
Camil Staps committed
164 165 166 167
				, "match failure"
				)
			# end = EndEvent
				{ name     = name
168
				, location = Just cur_location
Camil Staps's avatar
Camil Staps committed
169 170 171
				, event    = event
				, message  = msg
				}
Camil Staps's avatar
Camil Staps committed
172
			-> tell end
Camil Staps's avatar
Camil Staps committed
173
run_test_input _ TNoMatch =
174
	gets id >>= \{cur_names=names=:[name:_],cur_location,cur_skipped,cur_regex,cur_input,cur_matches}
175
	| cur_skipped || isNothing cur_regex ->
Camil Staps's avatar
Camil Staps committed
176
		pure ()
177
	| otherwise -> case cur_matches of
Camil Staps's avatar
Camil Staps committed
178 179 180
		[]
			# end = EndEvent
				{ name     = name
181
				, location = Just cur_location
Camil Staps's avatar
Camil Staps committed
182 183 184
				, event    = Passed
				, message  = ""
				}
Camil Staps's avatar
Camil Staps committed
185
			-> tell end
186
		[{start,end}:_]
Camil Staps's avatar
Camil Staps committed
187 188
			# end = EndEvent
				{ name     = name
189
				, location = Just cur_location
190 191
				, event    = Failed (Just (CustomFailReason
					(concat ["expected no match; got (",toString start,",",toString end,")"])))
Camil Staps's avatar
Camil Staps committed
192 193
				, message  = "expected no match"
				}
Camil Staps's avatar
Camil Staps committed
194
			-> tell end
Camil Staps's avatar
Camil Staps committed
195 196 197 198 199 200 201 202 203 204 205 206 207 208

read :: !Int !File -> [(Int,TestInput)]
read lineno f
	| sfend f
		= []
	# (ln,f) = sfreadline f
	# lineno = lineno + 1
	| size ln == 1 && ln.[0] == '\n' // empty line
		= read lineno f
	| ln.[0] == '#' // comment
		= read lineno f
	| ln.[0] == '/' // regex
		// TODO: flags
		= [(lineno,TRegex False (ln % (1,size ln-3))):read lineno f]
Camil Staps's avatar
Camil Staps committed
209 210 211 212
	| ln.[0] == 's' && ln.[1] == 'k' && ln.[2] == 'i' && ln.[3] == 'p' &&
			ln.[4] == ':' && ln.[5] == '/' // skipped regex
		= [(lineno,TRegex True (ln % (6,size ln-3))):read lineno f]
	| ln.[0] == ' ' && ln.[1] == ' ' && ln.[2] == ' ' && ln.[3] == ' ' // input
Camil Staps's avatar
Camil Staps committed
213
		= [(lineno,TInput (ln % (4,size ln-2))):read lineno f]
Camil Staps's avatar
Camil Staps committed
214
	| ln.[0] == ' ' && ln.[1] == ' ' // escaped input
215
		= [(lineno,TInput (unescape (ln % (2,size ln-2)))):read lineno f]
Camil Staps's avatar
Camil Staps committed
216
	| ln.[0] == ' ' && isDigit ln.[1] && ln.[2] == ':' && ln.[3] == ' ' // match
217
		= [(lineno,TMatch (toInt {#ln.[1]}) (unescape (ln % (4,size ln-2)))):read lineno f]
Camil Staps's avatar
Camil Staps committed
218
	| isDigit ln.[0] && isDigit ln.[1] && ln.[2] == ':' && ln.[3] == ' ' // match
Camil Staps's avatar
Camil Staps committed
219 220
		= [(lineno,TMatch (toInt (ln % (0,1))) (ln % (4,size ln-2))):read lineno f]
	| ln.[0] == 'N' && ln.[1] == 'o' && ln.[2] == ' ' && ln.[3] == 'm' &&
Camil Staps's avatar
Camil Staps committed
221
			ln.[4] == 'a' && ln.[5] == 't' && ln.[6] == 'c' && ln.[7] == 'h' // no match
Camil Staps's avatar
Camil Staps committed
222 223 224
		= [(lineno,TNoMatch):read lineno f]
	| ln.[0] == '\\' // \= Expect no match; basically a comment
		= read lineno f
Camil Staps's avatar
Camil Staps committed
225 226
	| ln.[0] == 'M' && ln.[1] == 'K' && ln.[2] == ':' // mark; ignore for now
		= read lineno f
Camil Staps's avatar
Camil Staps committed
227 228
	| otherwise
		= abort ("Unrecognized line in test input: "+++ln)
Camil Staps's avatar
Camil Staps committed
229

230 231 232
// For unescape
instance * Char where (*) a b = toChar (toInt a * toInt b)

233 234 235 236
unescape :: !String -> String
unescape s
	# cs = unescape [c \\ c <-: s]
	= {c \\ c <- cs}
Camil Staps's avatar
Camil Staps committed
237
where
238 239
	unescape :: ![Char] -> [Char]
	unescape ['\\','\\':cs] = ['\\':unescape cs]
240 241 242 243 244 245
	unescape ['\\','x',c1,c2:cs]
		| not (isHexDigit c1)
			= abort "invalid hexadecimal escape sequence"
		| isHexDigit c2
			= [toChar ((hex c1 << 4) + hex c2):unescape cs]
			= [toChar (hex c1):unescape [c2:cs]]
246 247 248 249 250 251 252 253 254
	where
		hex :: !Char -> Int
		hex c
			| isDigit c
				= toInt (c-'0')
			| isUpper c
				= toInt (c-'A') + 10
				= toInt (c-'a') + 10
	unescape ['\\','n':cs] = ['\n':unescape cs]
Camil Staps's avatar
Camil Staps committed
255 256 257 258
	unescape ['\\','t':cs] = ['\t':unescape cs]
	unescape ['\\','r':cs] = ['\r':unescape cs]
	unescape ['\\','f':cs] = ['\f':unescape cs]
	unescape ['\\','a':cs] = ['\x07':unescape cs]
259
	unescape ['\\','b':cs] = ['\x08':unescape cs]
Camil Staps's avatar
Camil Staps committed
260
	unescape ['\\','e':cs] = ['\x1b':unescape cs]
261 262 263 264 265 266 267 268 269 270 271 272
	unescape ['\\',c1:cs]
		| '0' <= c1 && c1 <= '7' = case cs of
			[] -> [c1-'0']
			[c2:cs]
				| '0' <= c2 && c2 <= '7' -> case cs of
					[] -> [(c1-'0')*'\10' + c2-'0']
					[c3:cs]
						| '0' <= c3 && c3 <= '7'
							-> [(c1-'0')*'\100' + (c2-'0')*'\10' + c3-'0':unescape cs]
							-> [(c1-'0')*'\10' + c2-'0':unescape [c3:cs]]
				| otherwise -> [c1-'0':unescape [c2:cs]]
		| otherwise = abort ("unknown escape sequence '\\"+++{c1}+++"'\n")
273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304
	unescape [c:cs] = [c:unescape cs]
	unescape [] = []

escape :: !String -> String
escape s
	# sz = size s
	# escsz = escaped_size (sz-1) s 0
	| sz == escsz
		= s
		= copy (sz-1) (escsz-1) (createArray escsz '\0')
where
	copy :: !Int !Int !*String -> .String
	copy -1 _ new = new
	copy si newi new
		| s.[si] > '\x7f' || s.[si] < '\x20'
			= copy (si-1) (newi-4)
				{ new
				& [newi-3] = '\\'
				, [newi-2] = 'x'
				, [newi-1] = hex (toInt s.[si] >> 4)
				, [newi]   = hex (toInt s.[si] bitand 0x0f)
				}
			= copy (si-1) (newi-1) {new & [newi]=s.[si]}
	where
		hex i = "0123456789abcdef".[i]

	escaped_size :: !Int !String !Int -> Int
	escaped_size -1 _ n = n
	escaped_size i s n
		| s.[i] > '\x7f' || s.[i] < '\x20'
			= escaped_size (i-1) s (n+4)
			= escaped_size (i-1) s (n+1)