Add all the assignment code.

Signed-off-by: jmug <u.g.a.mariano@gmail.com>

hw4/util/assert.ml

@@ -0,0 +1,160 @@
+(* This code is mostly based on a course held at *)
+(* University of Pennsylvania (CIS341) by Steve Zdancewic. *)
+
+(* Author: Steve Zdancewic *)
+(* Modified by: Manuel Rigger *)
+(* Modified by: Yann Girsberger *)
+
+(* Do NOT modify this file -- we will overwrite it     *)
+(* with our own version when testing your code.        *)
+
+
+
+(* An assertion is just a unit->unit function that either *)
+(* succeeds silently or throws an Failure exception.       *)
+type assertion = (unit -> unit)
+
+type 'a test = 
+  | GradedTest of string * int * (string * 'a) list
+  | Test of string * (string * 'a) list
+
+type suite = (assertion test) list
+
+
+(**************)
+(* Assertions *)
+exception Timeout
+
+let timeout_assert (time : int) (a : assertion) : assertion =
+  fun () ->
+    let handler = Sys.Signal_handle (fun _ -> raise Timeout) in
+    let old = Sys.signal Sys.sigalrm handler in
+    let reset_sigalrm () = Sys.set_signal Sys.sigalrm old in
+    ignore (Unix.alarm time);
+    try begin a (); reset_sigalrm () end
+    with Timeout -> reset_sigalrm (); failwith @@ Printf.sprintf "Timed out after %d seconds" time
+       | exc -> reset_sigalrm (); raise exc
+
+let timeout_test (time : int) (t : assertion test) : assertion test =
+  let map_timeout l = List.map (fun (i, a) -> (i, timeout_assert time a)) l in
+  match t with
+  | GradedTest (s, i, ls) -> GradedTest (s, i, map_timeout ls) 
+  | Test (s, ls) -> Test (s, map_timeout ls)
+
+let timeout_suite (time : int) (s : suite) : suite =
+  List.map (timeout_test time) s
+
+let timeout_assert_const (a: assertion) : assertion = 
+    timeout_assert 10 a
+
+let assert_eq v1 v2 : assertion =
+  timeout_assert_const (fun () -> if v1 <> v2 then failwith "not equal" else ())
+
+let assert_eqf f v2 : assertion =
+  timeout_assert_const (fun () -> if (f ()) <> v2 then failwith "not equal" else ())
+
+let assert_eqfs f v2 : assertion =
+  timeout_assert_const (fun () ->
+    let s1 = f () in
+    if s1 <> v2 then failwith @@ Printf.sprintf "not equal\n\texpected:%s\n\tgot:%s\n" v2 s1
+    else ())
+
+
+let assert_fail : assertion = fun () -> failwith "assert fail"
+
+
+(***************************)
+(* Generating Test Results *)
+
+type result = 
+  | Pass 
+  | Fail of string
+
+type outcome = (result test) list
+
+let run_assertion (f:assertion) : result =
+  try 
+    f ();
+    Pass
+  with
+    | Failure m -> Fail m
+    | e -> Fail ("test threw exception: " ^ (Printexc.to_string e))
+
+let run_test (t:assertion test) : result test =
+  let run_case (cn, f) = (cn, run_assertion f) in
+  begin match t with
+    | GradedTest (n,s,cases) ->
+      Printf.eprintf "Running test %s\n%!" n;
+      GradedTest(n,s,List.map run_case cases)
+
+    | Test (n, cases) ->
+      Printf.eprintf "Running test %s\n%!" n;
+      Test(n, List.map run_case cases)
+  end
+  
+let run_suite (s:suite):outcome =
+  List.map run_test s
+
+
+
+
+
+(***********************)
+(* Reporting functions *)
+
+let result_test_to_string (name_pts:string) (r:result test): string =
+  let string_of_case (name, res) = 
+     begin match res with
+      | Pass     -> "passed - " ^ name 
+      | Fail msg -> "FAILED - " ^ name ^ ": " ^ msg
+    end 
+  in
+  begin match r with
+    | GradedTest (_, _, cases)
+    | Test (_, cases) ->
+      name_pts ^
+      (List.fold_left (fun rest -> fun case -> rest ^ "\n" ^ (string_of_case case)) "" cases)
+  end
+
+(* returns (name_pts, passed, failed, total, points_earned, max_given, max_hidden) *)
+let get_results (t:result test) =
+  let num_passed cases = 
+    List.fold_left (fun cnt (_,r) -> match r with Pass -> cnt + 1 | _ -> cnt) 0 cases in
+  let num_failed cases = 
+    List.fold_left (fun cnt (_,r) -> match r with Fail _ -> cnt + 1 | _ -> cnt) 0 cases in
+  begin match t with
+    | GradedTest (name,pts,cases) ->
+      let passed = num_passed cases in
+      let failed = num_failed cases in
+      let total = List.length cases in
+      if total > 0 then
+          let points_earned = ((float_of_int passed) /. (float_of_int total)) *. (float_of_int pts) in
+          let name_pts = Printf.sprintf "%s (%1.f/%d points)" name points_earned pts in
+          (name_pts, passed, failed, total, points_earned, pts, 0)
+        else
+          let name_pts = Printf.sprintf "%s (?/%d points)" name pts in
+          (name_pts, passed, failed, total, 0.0, 0, pts)
+    | Test(name, cases) ->
+      let total = List.length cases in
+      let passed = num_passed cases in
+      let failed = num_failed cases in
+      (name, passed, failed, total, 0.0, 0, 0)
+  end
+
+let outcome_to_string (o:outcome):string =
+  let sep = "\n---------------------------------------------------\n" in
+  let helper  (passed, failed, total, pts, maxg, maxh, str) (t:result test) =
+    let (name_pts, p, f, tot, s, mg, mh) = get_results t in
+    (passed + p, failed + f, total + tot, s +. pts, maxg + mg, maxh + mh, 
+    str ^ "\n" ^ (
+      if f > 0 then (result_test_to_string name_pts t) else 
+      if tot > 0 then (name_pts ^ ":\n  OK") else
+        (name_pts ^ ":\n  Hidden") 
+      )
+    ) in
+  let (p,f,tot,pts,maxg, maxh,str) = List.fold_left helper (0,0,0,0.0,0,0,"") o in
+  str ^ sep ^ (Printf.sprintf "Passed: %d/%d\nFailed: %d/%d\nScore: %1.f/%d (given)\n       ?/%d (hidden)" p tot f tot pts maxg maxh)
+  
+
+
+