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
|
(* assert.sml
* 2004 Matthew Fluet (mfluet@acm.org)
* Ported to MLton threads.
*)
structure Assert: ASSERT =
struct
structure C = Critical
val assertFlg = true
fun fail msg =
(C.atomicBegin ();
TextIO.print (concat ["ASSERT: ", msg, "\n"]);
OS.Process.exit OS.Process.failure)
fun assert (msgs: (unit -> string) list,
msg: unit -> string,
f: unit -> bool): unit =
if assertFlg andalso not (f () handle _ => false)
then let
val msgs = List.map (fn f => f ()) msgs
val msg = concat [String.concatWith " " msgs, " :: ", msg ()]
in
fail msg
end
else ()
fun assert' (msg: string, f: unit -> bool): unit =
assert ([], fn () => msg, f)
datatype z = datatype MLton.Thread.AtomicState.t
fun assertAtomic (msg: unit -> string, n: int option): unit =
assert ([C.atomicMsg], msg, fn () =>
case MLton.Thread.atomicState () of
Atomic m => (case n of NONE => true | SOME n => n = m)
| NonAtomic => false)
fun assertNonAtomic (msg: unit -> string): unit =
assert ([C.atomicMsg], msg, fn () =>
case MLton.Thread.atomicState () of
Atomic _ => false
| NonAtomic => true)
fun assertAtomic' (msg, n) = assertAtomic (fn () => msg, n)
fun assertNonAtomic' msg = assertNonAtomic (fn () => msg)
end
|
