Permalink
Browse files

Initial commit of some test code

Signed-off-by: Mike McClurg <mike.mcclurg@citrix.com>
  • Loading branch information...
Mike McClurg
Mike McClurg committed Sep 26, 2012
0 parents commit 096bdcb2e1bd7cdf5d884d31ead7e20bc81d2bd6
Showing with 310 additions and 0 deletions.
  1. +81 −0 fcm/bench.ml
  2. +7 −0 fcm/dep.ml
  3. +6 −0 fcm/fcm-test.ocp
  4. +4 −0 fcm/functor_test.ml
  5. +8 −0 fcm/globs.ml
  6. +31 −0 fcm/impl.ml
  7. +4 −0 fcm/main.ml
  8. +111 −0 fcm/test.ml
  9. +25 −0 notes.org
  10. +33 −0 ocp-build.root
@@ -0,0 +1,81 @@
+module MyDepD = Dep.Dependency
+
+let _ =
+
+ let n = int_of_float 10e7 in
+
+ let module MyDepI1 = (val !Globs.dependencyMod : Globs.DependencySIG) in
+ let module MyDepI2 = (val Globs.dependencyMod2 : Globs.DependencySIG) in
+
+ let myDepI3 = !Globs.dependencyMod in
+ let module MyDepI3 = (val myDepI3 : Globs.DependencySIG) in
+
+ let myDepI4 = if Globs.use_impl
+ then (module Dep.Dependency : Globs.DependencySIG)
+ else (module Dep.Dependency : Globs.DependencySIG) in
+ let module MyDepI4 = (val myDepI4 : Globs.DependencySIG) in
+
+ let myDepHash = Hashtbl.create 1 in
+ Hashtbl.add myDepHash 0 (module Dep.Dependency : Globs.DependencySIG) ;
+ let module MyDepI5 = (val (Hashtbl.find myDepHash 0) : Globs.DependencySIG) in
+
+ (* time for direct function call *)
+ let time_direct_start = Sys.time () in
+ for i = 1 to n do
+ ignore (Dep.Dependency.func1 ())
+ done ;
+ let time_direct_end = Sys.time () in
+
+ Printf.printf "Time for direct call: %f\n"
+ (time_direct_end -. time_direct_start) ;
+
+ (* time for indirect function call through first class module *)
+ let time_indirect_start = Sys.time () in
+ for i = 0 to n do
+ ignore (MyDepI3.func1 ())
+ done ;
+ let time_indirect_end = Sys.time () in
+
+ Printf.printf "Time for indirect call, dereferenced once: %f\n"
+ (time_indirect_end -. time_indirect_start) ;
+
+ (* time for indirect function call through first class module, no ref *)
+ let time_indirect_start = Sys.time () in
+ for i = 0 to n do
+ ignore (MyDepI2.func1 ())
+ done ;
+ let time_indirect_end = Sys.time () in
+
+ Printf.printf "Time for indirect call, no reference: %f\n"
+ (time_indirect_end -. time_indirect_start) ;
+
+ (* time for indirect function call through first class module and if, no ref *)
+ let time_indirect_start = Sys.time () in
+ for i = 0 to n do
+ ignore (MyDepI4.func1 ())
+ done ;
+ let time_indirect_end = Sys.time () in
+
+ Printf.printf "Time for indirect call through if statement, no reference: %f\n"
+ (time_indirect_end -. time_indirect_start) ;
+
+ (* time for indirect function call through dereferenced first class module *)
+ let time_indirect_start = Sys.time () in
+ for i = 0 to n do
+ ignore (MyDepI1.func1 ())
+ done ;
+ let time_indirect_end = Sys.time () in
+
+ Printf.printf "Time for indirect call through reference: %f\n"
+ (time_indirect_end -. time_indirect_start) ;
+
+ (* time for indirect function call through hash table *)
+ let time_indirect_start = Sys.time () in
+ for i = 0 to n do
+ ignore (MyDepI5.func1 ())
+ done ;
+ let time_indirect_end = Sys.time () in
+
+ Printf.printf "Time for indirect call through hash table: %f\n"
+ (time_indirect_end -. time_indirect_start) ;
+
@@ -0,0 +1,7 @@
+(* Thing that the SUT depends on, that we want to mock out *)
+module Dependency =
+struct
+ let func1 () = 42
+ let func2 () = print_endline "Production implementation"
+ let func3 a b = Printf.sprintf "string: %s, int: %d" a b
+end
@@ -0,0 +1,6 @@
+begin program "fcm-test"
+ sort = true
+ comp = [ "-bin-annot" ]
+ files = [ "test.ml" "main.ml" "impl.ml" "globs.ml" "functor_test.ml" "dep.ml" "bench.ml" ]
+ requires = [ ]
+end
@@ -0,0 +1,4 @@
+module Make = functor (M: Globs.DependencySIG) ->
+struct
+ include Impl.SUT
+end
@@ -0,0 +1,8 @@
+module type DependencySIG = module type of Dep.Dependency
+
+let dependencyMod = ref (module Dep.Dependency : DependencySIG)
+
+let dependencyMod2 = (module Dep.Dependency : DependencySIG)
+
+let use_impl_ref = ref true
+let use_impl = true
@@ -0,0 +1,31 @@
+module MyDep = (val !Globs.dependencyMod : Globs.DependencySIG)
+
+module type HASHTBL = module type of Hashtbl
+(* SUT *)
+module SUT =
+struct
+ module Make =
+ functor (Dependency : Globs.DependencySIG) ->
+ functor (H : HASHTBL) ->
+ struct
+ let sut_func () =
+ print_endline "- sut_func() :" ;
+ print_endline (Dependency.func3 "a" 1) ;
+ end
+ include Make(Dep.Dependency)(Hashtbl)
+end
+
+module SUT_orig =
+struct
+ open Dep
+ let sut_func () =
+ print_endline "- sut_func() :" ;
+ print_endline (Dependency.func3 "a" 1) ;
+end
+
+
+(* print_endline "- Function-level definition:" ; *)
+(* let module MyDep = (val !Globs.dependencyMod :
+ Globs.DependencySIG) in *)
+(* print_endline (MyDep.func3 "a" 1) ; *)
+(* print_endline (string_of_int (MyDep.func1 ())) ; *)
@@ -0,0 +1,4 @@
+(* This is the main function of the "production" code *)
+let _ =
+ print_endline "** Production **" ;
+ Impl.SUT.sut_func ()
@@ -0,0 +1,111 @@
+module type EXPECTATION =
+sig
+ exception No_return_set
+ exception Violation
+ type t
+ val make : unit -> t
+ val init : unit
+end
+
+module Expectation =
+struct
+ exception No_return_set
+ exception Violation
+ type expect_key = string
+ type expect_val = string
+ type t = (expect_key, expect_val) Hashtbl.t
+ let make () = Hashtbl.create 10
+end
+
+(* This is the mock of Dependency. We'll write it out by hand to see
+ what shape we'd like our framework to take. *)
+module DependencyMock =
+struct
+ (* A type which defines the input signature of each function that
+ we're mocking. *)
+ type funcs =
+ | F_func1 of unit
+ | F_func2 of unit
+ | F_func3 of string * int
+ | F_func3_lambda of (string -> int -> string)
+
+ (* A type which defines the return values types for each function
+ we're mocking. XXX: how do we represent exceptions? *)
+ type returns =
+ | R_func1 of int
+ | R_func2 of unit
+ | R_func3 of string
+
+ type const =
+ | C_one_of
+ | C_at_least_one_of
+
+ type actions =
+ | Func of funcs
+
+ (* A hashtable of function calls and their return values *)
+ let exp = (Hashtbl.create 10 : (funcs, returns) Hashtbl.t)
+
+ type _ exp_gadt =
+ | OneOf : actions -> actions exp_gadt
+ | AtLeastOneOf : actions -> actions exp_gadt
+
+ (* let init () = *)
+ (* Hashtbl.add *)
+ (* let expect = Expectation.make () *)
+
+ (* Mocked functions *)
+ let set_func1 a r = Hashtbl.add exp (F_func1 a) (R_func1 r)
+ let func1 () =
+ let f = F_func1 () in
+ if Hashtbl.mem exp f
+ then let r = Hashtbl.find exp f in
+ match r with
+ | R_func1 r -> r
+ | _ -> raise Expectation.No_return_set
+ (* XXX: should record violations instead of excepting *)
+ else raise Expectation.Violation
+
+ let func2 () = print_endline "Mock implementation"
+
+ (* A more interesting function to mock *)
+ let set_func3 a b r = Hashtbl.add exp (F_func3 (a, b)) (R_func3 r)
+ let set_func3_lambda: (string -> int -> string) -> unit =
+ fun f -> ()
+ let func3 a b =
+ let f = F_func3 (a,b) in
+ if Hashtbl.mem exp f
+ then let r = Hashtbl.find exp f in
+ match r with
+ | R_func3 r -> r
+ | _ -> raise Expectation.No_return_set
+ (* XXX: should record violations instead of excepting *)
+ else raise Expectation.Violation
+
+end
+
+(* module type SUT_type = module type of Impl.SUT *)
+
+(* module SUT_test = *)
+(* functor (D : Globs.DependencySIG) -> *)
+(* struct *)
+(* include (Impl.SUT : SUT_type with module MyDep = D) *)
+(* (\* module MyDep = D *\) *)
+(* (\* include Impl.SUT *\) *)
+(* end *)
+
+(* Run the test, substituting our custom mock module for Dependency *)
+let _ =
+ print_endline "** Test **" ;
+ Globs.dependencyMod := (module DependencyMock : Globs.DependencySIG) ;
+ DependencyMock.set_func3 "a" 1 "MOCK string: a, int: 1" ;
+ DependencyMock.set_func1 () 1 ;
+ (* let module My_SUT = Impl.SUT(Dep.Dependency) in *)
+ Impl.SUT.sut_func () ;
+ let module My_SUT = Impl.SUT.Make(DependencyMock)(Hashtbl) in
+ My_SUT.sut_func () ;
+
+(* Expectation is an action with a list of conditions (at least once,
+ only once, etc.). After an action on the mock is performed, it will
+ be recorded. Either after each action, or at the end of the
+ test, the conditions can be checked. *)
@@ -0,0 +1,25 @@
+_Design notes for MoCaml test framework_
+
+* Requirements
+ - Dependency Injection
+ - Need a way to "install" the newly created test doubles
+ - This might be useful as a standalone library
+ - Might provide multiple solutions
+ - First class modules and references
+ - First class modules and runtime lookup
+ - Functors?
+ - Link-time implementation swapping
+ - Test Double Creation
+ - Automatically generate an implemetation of an interface
+ - camlp4
+ - Mocks
+ - Expectations
+ - Should handle:
+ - Exceptions
+ - Function calls, both arguments and returns
+ - Counting events (at least once, exactly N times, etc.)
+ - How do we handle such rich expectations? We need more than
+ just a hash table lookup, since we need to deal with number
+ of times that an action is performed, etc.
+ - JMock will fail as soon as an expectation is violated, not
+ after a validation step. I think we should do this too.
@@ -0,0 +1,33 @@
+
+
+ (************************************)
+ (* Never edit options files while *)
+ (* the program is running *)
+ (************************************)
+ (* SECTION : Header *)
+ (* These options must be read first *)
+ (************************************)
+
+
+
+ (* List of configuration files for this project *)
+ files = [
+ "/home/mike/Projects/ocaml/mocaml/test.ocp";
+ "/home/mike/Projects/ocaml/mocaml/fcm/fcm-test.ocp";]
+
+ (* The version of ocp-build used to save this file *)
+ ocpbuild_version = "2011-11-16 08:47 Fabrice"
+
+ (* Always scan for .ocp files in this project sub-directories
+ - 'None' means use default user settings;
+ - 'true'/'false' override user setttings *)
+ autoscan = true
+
+ (* Number of cores to use on this computer *)
+ ncores = None
+
+ (* Default verbosity *)
+ verbosity = None
+
+ (* Use content digest change instead of modification to trigger recompilation *)
+ digest = None

0 comments on commit 096bdcb

Please sign in to comment.