Simple unit testing framework for SML

sml_spec.sml

(* helper functions *)
exception AssertionFailure;
fun println(msg) = print(msg ^ "\n");
fun printStatusWithWidth(label, msg, width) = println("\t- " ^ (StringCvt.padRight #" "  width msg) ^ label);
fun printStatus(label, msg) = printStatusWithWidth(label,msg,80)

fun msg_pass(msg) = printStatus("[ PASS ]", msg);
fun msg_fail(msg) = printStatus("[ FAIL ]", msg);

datatype AssertResult = Pass of string| Fail of string;
datatype  assertion = Claim of string * bool;

(* Polymorphic assertions, allows one to build up a typesafe library of 'predicates' for use in describe blocks *)
datatype ''a assertion = 
    ListEq of string * ''a list * ''a list | 
    ListContains of string * ''a * ''a list |
    StrEq of string * string * string |
    IntEq of string * int * int |
    AssertThat of string * bool |
    AssertFalse of string * bool |
    Throws of (unit -> unit) * exn

fun assertActualMatchesExpected(msg, exp, actual, failMsgFunc) =
    if exp = actual then
        msg_pass(msg ^ " -- OK ")
    else
    (
        msg_fail(msg);
        println("\t\t(" ^ failMsgFunc(msg, exp, actual) ^ ")")
    )

fun assertTrue(msg, pred) =
    if pred then
        msg_pass(msg ^ " -- OK ")
    else
        msg_fail(msg ^ " -- Assertion Failed!")

fun assertException(f, ex) =
    (
        (
            f(); 
            msg_fail("Expected exception * NOT * found!")  
        )
        handle ex => msg_pass("Found expected exception -- OK") 
        
    )

fun assertListContains(msg, elem, lst) =
    case List.find (fn x => x = elem) lst of
        SOME _ => msg_pass(msg ^ " -- Expected element found")
      | NONE => msg_fail(" -- Did not find expected element!")

(* pretty-printed msgs for various types *)
fun strEqFailFunc(msg,exp,actual) =
    "Expected: " ^ exp ^ ", but found: " ^ actual
   
fun intEqFailFunc(msg,exp,actual) = 
    msg ^ "Expected: " ^ Int.toString(exp) ^ ", but found: " ^ Int.toString(actual)


fun listEqFailFunc(msg,exp,actual) = 
    msg ^ "ExpectedLen: " ^ Int.toString(List.length(exp)) ^ 
            ", ActualLen: " ^ Int.toString(List.length(actual))

fun listContainsFailFunc(msg, exp, actual) =
    msg ^ " -- List does not contain specified element!"

fun genericFailFunc(msg,exp,actual) =
    msg ^ " -- Failed!"

(* The primary test client interface, can be used as follows: 

    describe "something to test" [
        ListEq("lists are the same", l1, l2),
        StrEq("Strings are equal", "foo", "foo"),
        IntEq("Integerta are equal", 5, x)
    ]
    
    Remember that the client interface for all describe expressions
    is the following:

        AssertType <message> <expected value> <actual value>

    as in xUnit.

    Extending this framework is easy:
        1) Add an assertion datatype constructor above (see the line about 'polymorphic assertions')
        2) Add a case to the case expression below for your new assertion type.

    Additionally you may need to implement a new failure function (see the ones above) or just
    use the generic one ('genericFailFunc')
*)
fun describe thing claims =
    let 
        fun check_result(assertion) =
            case assertion of
                ListEq(msg,exp,actual) => 
                    assertActualMatchesExpected(msg, exp, actual, listEqFailFunc)
            |   ListContains(msg,expElem,lst) =>
                    assertListContains(msg, expElem, lst)

            |  StrEq(msg,exp,actual) =>
                    assertActualMatchesExpected(msg, exp, actual, strEqFailFunc)

            | IntEq(msg,exp,actual) =>
                    assertActualMatchesExpected(msg, exp, actual, intEqFailFunc)
            | AssertThat(msg, result) =>
                assertTrue(msg, result)
            | AssertFalse(msg, result) =>
                assertTrue(msg, not(result))
            | Throws(f, ex) =>
                assertException(f, ex)

    in
     ( 
       (* don't print out val it := unit, etc., just print the tests *) 
       Control.Print.out := {say=fn _=>(), flush=fn()=>()};
       println("\nChecking assertions: [" ^ thing^"]");
       List.map check_result claims;
       println("\n")
     )
    end