Fuzzing

test/fuzz/basic.ml

@@ -462,7 +462,7 @@ let data_drop (env : Env.t) =
     (fun name -> pair (const (Data_drop (Symbolic name))) (const [ S.Nothing ]))
     env.datas
 
-let block_kind = choose [ const Env.Block; const Env.Loop (*; const Env.Func*) ]
+let block_kind = choose [ const Env.Block; const Env.Loop; const Env.Func ]
 
 let expr_call (env : Env.t) (stack : val_type list) =
   let stack_pt = List.map (fun _ -> S.Pop) in
@@ -490,11 +490,16 @@ let expr_br_if (env : Env.t) (stack : val_type list) =
         | Arg.Bt_raw (_, (pt, rt)) ->
           let is_stack_compatible =
             match bk with
-            | Env.Block -> S.is_stack_compatible tl (List.rev rt)
+            | Env.Block | Env.Func -> S.is_stack_compatible tl (List.rev rt)
             | Env.Loop -> S.is_stack_compatible_param tl (List.rev pt)
           in
           if not is_stack_compatible then None
-          else Some (pair (const (Br (Symbolic name))) (const [ S.Pop ]))
+          else 
+            let i = match bk with
+            | Env.Block | Env.Loop -> const @@ Br_if (Symbolic name)
+            | Env.Func -> const @@ Br_if (Raw ((List.length blocs) - 1))
+            in
+            Some ( pair i (const [ S.Pop ]) )
         | _ -> None )
       blocs
 
@@ -512,14 +517,16 @@ let expr_br (env : Env.t) (stack : val_type list) =
       | Arg.Bt_raw (_, (pt, rt)) ->
         let is_stack_compatible =
           match bk with
-          | Env.Block -> S.is_stack_compatible stack (List.rev rt)
+          | Env.Block | Env.Func -> S.is_stack_compatible stack (List.rev rt)
           | Env.Loop -> S.is_stack_compatible_param stack (List.rev pt)
         in
         if not is_stack_compatible then None
         else
-          Some
-            (let i = const @@ Br (Symbolic name) in
-             pair i random_stack )
+          let i = match bk with
+          | Env.Block | Env.Loop -> const @@ Br (Symbolic name)
+          | Env.Func -> const @@ Br (Raw ((List.length blocs) - 1))
+          in
+          Some ( pair i random_stack )
       | _ -> None )
     blocs
 

test/fuzz/env.ml

@@ -1,9 +1,9 @@
 open Owi.Symbolic
-open Crowbar
 
 type block_kind =
   | Block
   | Loop
+  | Func
 
 type t =
   { mutable next_data : int

test/fuzz/fuzzer.ml

@@ -36,21 +36,26 @@ let check_optimized m =
     | Some Error msg1, Some Error msg2 when msg1 = msg2 -> true
     | Some Error msg1, Some Error msg2 ->
       Format.ksprintf failwith
-        "unoptimized module and optimized module interpretations throw \
+        "[Owi unoptimized and optimized comparaison] \
+         unoptimized module and optimized module interpretations throw \
          different errors: %s / opti: %s"
         msg1 msg2
     | Some Error msg, Some Ok () ->
       Format.ksprintf failwith
-        "only unoptimized module interpretation throws an error: %s" msg
+        "[Owi unoptimized and optimized comparaison] \
+         only unoptimized module interpretation throws an error: %s" msg
     | Some Ok (), Some Error msg ->
       Format.ksprintf failwith
-        "only optimized module interpretation throws an error: %s" msg
+        "[Owi unoptimized and optimized comparaison] \
+         only optimized module interpretation throws an error: %s" msg
     | None, Some _ -> 
       Format.ksprintf failwith
-        "only unoptimized module interpretation throws a timeout error"
+        "[Owi unoptimized and optimized comparaison] \
+         only unoptimized module interpretation throws a timeout error"
     | Some _, None ->
       Format.ksprintf failwith
-        "only optimized module interpretation throws a timeout error"
+        "[Owi unoptimized and optimized comparaison] \
+         only optimized module interpretation throws a timeout error"
   in
   let result2 =
     (not Param.reference_fuzzing)
@@ -63,16 +68,20 @@ let check_optimized m =
       true
     | Some Error msg, Some Ok () ->
       Format.ksprintf failwith
-        "only unoptimized module interpretation throws an error: %s" msg
+        "[Reference and Owi interpreters comparaison] \
+         only unoptimized module interpretation throws an error: %s" msg
     | Some Ok (), Some Error msg ->
       Format.ksprintf failwith
-        "only reference module interpretation throws an error: %s" msg
+        "[Reference and Owi interpreters comparaison] \
+         only reference module interpretation throws an error: %s" msg
     | None, Some _ -> 
       Format.ksprintf failwith
-        "only unoptimized module interpretation throws a timeout error"
+        "[Reference and Owi interpreters comparaison] \
+         only unoptimized module interpretation throws a timeout error"
     | Some _, None ->
       Format.ksprintf failwith
-        "only optimized module interpretation throws a timeout error"
+        "[Reference and Owi interpreters comparaison] \
+         only optimized module interpretation throws a timeout error"
   in
   result1 && result2
 

test/fuzz/gen.ml

@@ -133,23 +133,22 @@ let expr_available_2_f64 =
 (* let expr_available_3_f64 = [] *)
 
 let if_else expr ~locals ~stack env =
-  (* TODO: finish > bug typechecking + List.rev *)
   match stack with
   | Num_type I32 :: _stack -> begin
     let* rt = list B.val_type in
-    (* let* pt = B.stack_prefix stack in *)
-    let* pt = const [] in
+    let* pt = B.stack_prefix (List.tl stack) in
     let typ =
       Arg.Bt_raw (None, (List.rev_map (fun t -> (None, t)) pt, List.rev rt))
     in
+    let id = Env.add_block env typ Env.Block in   (* same behavior as block *)
     let old_fuel = env.Env.fuel in
     env.fuel <- old_fuel / 2;
     let* expr_then = expr ~block_type:typ ~stack:pt ~locals env in
     env.fuel <- old_fuel / 2;
     let* expr_else = expr ~block_type:typ ~stack:pt ~locals env in
     env.fuel <- old_fuel / 2;
-
-    let+ instr = const @@ If_else (None, Some typ, expr_then, expr_else)
+    Env.remove_block env;
+    let+ instr = const @@ If_else (Some id, Some typ, expr_then, expr_else)
     and+ pt_descr = const @@ (S.Pop :: List.map (fun _ -> S.Pop) pt)
     and+ rt_descr = const @@ List.rev_map (fun t -> S.Push t) rt in
     (instr, pt_descr @ rt_descr)
@@ -169,8 +168,9 @@ let block block_kind expr ~locals ~stack env =
     const
     @@
     match block_kind with
-    | Block -> Block (Some id, Some typ, expr)
-    | Loop -> Loop (Some id, Some typ, expr)
+    | Env.Block -> Block (Some id, Some typ, expr)
+    | Env.Loop -> Loop (Some id, Some typ, expr)
+    | Env.Func -> assert false
   and+ pt_descr = const @@ List.map (fun _ -> S.Pop) pt
   and+ rt_descr = const @@ List.rev_map (fun t -> S.Push t) rt in
   (instr, pt_descr @ rt_descr)
@@ -267,7 +267,9 @@ let func env =
   Env.refill_fuel env;
   let* locals = list (local env) in
   let* type_f = B.block_type env in
+  let _ = Env.add_block env type_f Env.Func in
   let+ body = expr ~block_type:type_f ~stack:[] ~locals env in
+  Env.remove_block env;
   let id = Some (Env.add_func env type_f) in
   MFunc { type_f; locals; body; id }