hphp/hack/test/unit/unit_test.ml

   1 (*
   2  * Copyright (c) 2015, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *
   9  *)
  10
  11 open Hh_prelude
  12
  13 exception Expected_throw_missing
  14
  15 exception Thrown_exception_mismatched of (exn * exn)
  16
  17 let expect_throws e f x =
  18   try
  19     let _ = f x in
  20     Printf.eprintf "Error. Did not throw expected: %s\n" (Exn.to_string e);
  21     false
  22   with
  23   | err ->
  24     if Poly.(e <> err) then
  25       let () =
  26         Printf.eprintf
  27           "Error. Expected exn: %s. But got : %s\n"
  28           (Exn.to_string e)
  29           (Exn.to_string err)
  30       in
  31       false
  32     else
  33       true
  34
  35 let run (name, f) =
  36   Printf.printf "Running %s ... %!" name;
  37   let result =
  38     try f () with
  39     | e ->
  40       let e = Exception.wrap e in
  41       let () = Printf.printf "Exception %s\n" (Exception.to_string e) in
  42       let () =
  43         Printf.printf "Backtrace %s\n" (Exception.get_backtrace_string e)
  44       in
  45       false
  46   in
  47   if result then
  48     Printf.printf "ok\n%!"
  49   else
  50     Printf.printf "fail\n%!";
  51   result
  52
  53 (** List.for_all but without shortcircuiting "&&", so runs all failures too. *)
  54 let for_all_non_shortcircuit tests f =
  55   List.fold_left tests ~init:true ~f:(fun acc test -> f test && acc)
  56
  57 let run_all (tests : (string * (unit -> bool)) list) =
  58   Printexc.record_backtrace true;
  59   exit
  60     (if for_all_non_shortcircuit tests run then
  61       0
  62     else
  63       1)
  64
  65 let run_only tests names =
  66   let f =
  67     match names with
  68     | [] -> const true
  69     | _ -> (fun (n, _) -> List.mem names n ~equal:String.( = ))
  70   in
  71   let tests = List.filter tests ~f in
  72   run_all tests
  73
  74 let main tests =
  75   let names = Option.value (List.tl @@ Array.to_list Sys.argv) ~default:[] in
  76   run_only tests names