Commits

Matthew Hammer  committed 274d2b1

tried to recreate assertion failure in isolation; was not able to do so

  • Participants
  • Parent commits 477bdf0
  • Branches nominal

Comments (0)

Files changed (5)

File Source/AdaptonUtil/AKList.ml

         constructor that may depend on other Adapton thunks. *)
     let update_thunk = L.update_thunk
 
+    let output_graph = L.output_graph
+
     include MemoN.Make (
       struct
         type data = L.data

File Source/AdaptonUtil/Signatures.ml

         val pop : t -> data * Key.t
         val insert : int -> data -> Key.t -> t -> unit (* Implemented. *)
         val remove : int -> t -> data * Key.t (* Implemented. *)
+        val output_graph : ?filename:string -> t -> unit
 
         val memo_map :
           (module AKListType.BasicS

File Source/AdaptonZoo/Adapton.ml

         )
         with
 	  | Some row -> begin
-              (*( assert_no_memo_keyed_bug symbol key cur_arg row ) ; *)
+              ( assert_no_memo_keyed_bug symbol key cur_arg row ) ;
               row.Row.seqno  <- !global_seqno ;    (* DEBUG only *)
               row.Row.caller <- current_caller () ; (* DEBUG only *)
               IFDEF ADAPTON_LOG THEN (

File Test/TestAdapton/TestAKList.ml

 let make_correctness_testsuite (module L : AdaptonUtil.Signatures.AKListType) =
   let module I = L.Make (AdaptonUtil.Types.Int) in
 
-  let test_aklist_op_with_test ?(count=150) ?size ?incl op a_op ~test =
+  let test_aklist_op_with_test ?(count=170) ?size ?incl op a_op ~test =
     Gc.compact (); (* try to make GC effects consistent across tests *)
     QC.forall ~count ?size ?incl (QC.triple QC.int (QC.list QC.int) (QC.list (QC.list (QC.triple QC.bool QC.int QC.int)))) begin fun ( label, xs, kss ) ->
       Random.init label;

File Test/nominaladaptontest.ml

         loop xs
   in loop xs
 
+let print_list' ?lab:(lab="") xs =
+  if lab <> "" then Printf.printf "%s: " lab ;
+  let rec loop = function
+    | [] -> Printf.printf "\n"
+    | x::xs ->
+        Printf.printf "%s " (string_of_int x) ;
+        loop xs
+  in loop xs
+
 type edit_stream = [ `Done of int | `More of unit -> edit_stream ]
 
 let insert_delete_stream (list:AKLi.t) : edit_stream =
     let error_message =
       "\n  update\n    expected: 2 but got: 3\n  on input: (2, [],\n            [[(true, -5, -4); (false, -6, 1)];\n             [(true, 5, 1); (true, 2, 5); (true, -4, -2); (false, 3, 1);\n              (true, 0, 4)\n             ]; [(true, 1, 3); (false, -1, -3)];\n             [(true, 1, -2); (false, 2, -1)]; [(false, 5, 3)]\n            ])"
 
+    let name  = "sumSmall"
     let label = 2
     let list  = []
     let edits =
   module Test_case_2_passes = struct
     let error_message = "\n  update\n    expected: -12 but got: -16\n  on input: (2, [4; -8; -3; -2; -7; -4],\n            [[(true, -9, -1)];\n             [(true, 8, -2); (false, 6, -4); (true, 0, -2); (true, -8, 0);\n              (false, -5, -3); (true, 9, 8); (true, -3, -6); (false, -4, -7)\n             ];\n             [(false, -10, -9); (true, 3, 2); (false, 6, -9); (true, -1, -6);\n              (false, 7, 8); (true, 0, -3)\n             ];\n             [(false, -10, -7); (true, 4, 2); (false, -7, 0);\n              (false, -1, -1); (false, -10, -7); (false, -6, -3);\n              (true, -7, -4)\n             ]; [(false, 2, -3)];\n             [(true, -9, 6); (false, 2, 4); (true, -2, -8); (false, 2, 8);\n              (true, -4, 3); (true, 8, 7); (true, 8, -3); (false, -10, -8);\n              (true, 2, 2)\n             ];\n             [(false, -6, 4); (false, -8, -7); (false, 3, -9); (true, -6, 6)];\n             [(false, -6, 1); (true, -4, 2); (true, 3, -10); (false, -3, -1);\n              (true, 6, -3); (true, 1, -6)\n             ]; []\n            ])"
 
+    let name  = "sumSmall"
     let label = 2
     let list = [4; -8; -3; -2; -7; -4]
     let edits =
       ]
   end
 
-  module Test_case = Test_case_2_passes
+  module Test_case__assertion_failure_1 = struct
+
+    let error_message = "input: (-2, [-14; -1; 11; -4; -2; 3; -15; -13; 13; 14; -12; -6; -11],\n[[(true, 9, -12); (true, -14, 12); (false, -2, 1)]])Unexpected exception: Failure(\"memo_keyed_bug(1)\")\n"
+    let label = -2
+    let list  = [-14; -1; 11; -4; -2; 3; -15; -13; 13; 14; -12; -6; -11]
+    let edits = [[(true, 9, -12); (true, -14, 12); (false, -2, 1)]]
+    let name  = "map"
+  end
+
+  module Test_case = struct
+    let error_message = 
+"\n  \n  on input: (2, [1], [[(true, 0, 0)]; [(true, 1, -4)]])Unexpected exception: Failure(\"memo_keyed_bug(2)\")\n                                                         Raised at file \"pervasives.ml\", line 20, characters 22-33\n                                                         Called from file \"Source/AdaptonZoo/Adapton.ml\", line 624, characters 16-63\n                                                         Called from file \"Test/TestAdapton/TestAKList.ml\", line 19, characters 16-31\n                                                         Called from file \"Test/TestUtil/MyOUnit.ml\", line 318, characters 16-24\n                                                         Re-raised at file \"Test/TestUtil/MyOUnit.ml\", line 321, characters 22-23\n                                                         Called from file \"Test/TestUtil/MyOUnit.ml\", line 331, characters 10-16\n                                                         Called from file \"Test/TestUtil/MyOUnit.ml\", line 28, characters 8-17"
+
+    let label = 2
+    let list  = [1]
+    let edits = [[(true, 0, 0)]; [(true, 1, -4)]]
+    let name  = "map"
+  end
 
   (* - - - - begin boilerplate - - - - - - *)
   module Apparatus = struct
   end
 
   module Driver = struct
+    (* make test-nominal OCAMLBUILD_EXTRAFLAGS='-ppflag "camlp4of -DADAPTON_LOG"' *)
+
     let _ = Printf.printf "\nRecreating this error: {%s\n}..\n" Test_case.error_message
 
     let found_bug : bool ref = ref false
 
+(*
     let test_app nondet list =
       I.memo_reduce (fun _ x y -> x + y)
         (nondet ())
         (* prepend 0 to avoid empty lists *)
         (I.const (`Cons ( 0, nondet (), list )))
         (nondet ())
+*)
+    let test_app nondet list =
+      AKLi.memo_map (module AKLi) succ (nondet ()) list
 
     let len   = List.length Test_case.list
     let list  = I.of_list ~nondet:Apparatus.nondet Test_case.list
     let out   = test_app Apparatus.nondet list
 
-    let output_graph () = AKLi.AData.output_graph out
+    (*let output_graph () = AKLi.AData.output_graph out*)
+    let output_graph () = AKLi.output_graph out
 
     let _ = AdaptonInternal.Log.usr_hooks.
       AdaptonInternal.Log.output_graph <- output_graph
 
     let _ = print_list ~lab:"☞ input (prepended 0 is elided)" (AKLi.force list)
-    let _ = Printf.printf "☛ output: %d\n" (AKLi.AData.force out)
+    (*let _ = Printf.printf "☛ output: %d\n" (AKLi.AData.force out)*)
+    let _ = print_list ~lab:"☛ output" (AKLi.force out)
 
     let _ =
       List.fold_left begin fun len batch_edit ->
         let len = Apparatus.do_batch_edit list len batch_edit in
-        (*output_graph () ;*)
         print_list ~lab:"☞ input (prepended 0 is elided)" (AKLi.force list) ;
-        let out_int  = (AKLi.AData.force out) in
+        (*let out_int  = (AKLi.AData.force out) in*)
+        let out_list = List.map fst (take_list (AKLi.force out)) in
         output_graph () ;
-        let expected = (List.fold_right (fun (x,_) y -> x + y) (take_list (I.force list)) 0) in
-        Printf.printf "☛ output: %d\n" out_int ;
-        Printf.printf "☛ expected: %d" expected ;
+        (*let expected = (List.fold_right (fun (x,_) y -> x + y) (take_list (I.force list)) 0) in*)
+        let expected = List.map succ (List.map fst (take_list (AKLi.force list))) in
+        print_list' ~lab:"☛ output:  " out_list ;
+        print_list' ~lab:"☛ expected:" expected ;
+        (*Printf.printf "☛ output: %d\n" out_int ;*)
+        (*Printf.printf "☛ expected: %d" expected ;*)
         begin
-        if out_int <> expected then (
+        if (*out_int*) out_list <> expected then (
           found_bug := true ;
           Printf.printf " ◀────── BUG!\n"
         )