Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

clean some code in the fuzzer #465

Merged
merged 1 commit into from
Dec 19, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion src/ast/types.ml
Original file line number Diff line number Diff line change
@@ -70,7 +70,7 @@ let pp_num_type fmt = function
let num_type_eq t1 t2 =
match (t1, t2) with
| I32, I32 | I64, I64 | F32, F32 | F64, F64 -> true
| _, _ -> false
| (I32 | I64 | F32 | F64), _ -> false

let compare_num_type t1 t2 =
let to_int = function I32 -> 0 | I64 -> 1 | F32 -> 2 | F64 -> 3 in
@@ -101,6 +101,8 @@ type nonrec mut =

let pp_mut fmt = function Const -> () | Var -> pf fmt "mut"

let is_mut = function Const -> false | Var -> true

type nonrec nn =
| S32
| S64
8 changes: 5 additions & 3 deletions test/fuzz/basic.ml
Original file line number Diff line number Diff line change
@@ -418,7 +418,7 @@ let memory_exists (env : Env.t) = Option.is_some env.memory

let memarg nsize =
let* offset = int32 in
let offset = if offset < 0l then Int32.sub 0l offset else offset in
let offset = if Owi.Int32.lt offset 0l then Int32.sub 0l offset else offset in
let+ align =
match nsize with
| NS8 -> const 0
@@ -549,11 +549,13 @@ let table_copy (env : Env.t) =
let instr =
let* name_x, (_lim_x, rt_x) = choose tables in
let* name_y, (_lim_y, rt_y) = choose tables in
if rt_x = rt_y then
match (rt_x, rt_y) with
| ((Null, ht1), (Null, ht2) | (No_null, ht1), (No_null, ht2))
when heap_type_eq ht1 ht2 ->
pair
(const (Table_copy (Text name_x, Text name_y)))
(const [ S.Pop; S.Pop; S.Pop ])
else pair (const Nop) (const [ S.Nothing ])
| _ -> pair (const Nop) (const [ S.Nothing ])
(* TODO: avoid if ... then ... else pair (const (Nop)) (const [ S.Nothing ])
https://github.com/OCamlPro/owi/pull/28#discussion_r1275222846 *)
in
24 changes: 12 additions & 12 deletions test/fuzz/env.ml
Original file line number Diff line number Diff line change
@@ -63,7 +63,7 @@ let get_blocks env = env.blocks

let add_data env =
let n = env.next_data in
let name = Format.sprintf "d%d" n in
let name = Fmt.str "d%d" n in
env.datas <- name :: env.datas;
env.next_data <- succ n;
name
@@ -72,57 +72,57 @@ let add_memory env =
match env.memory with
| None ->
let n = env.next_memory in
let name = Format.sprintf "m%d" n in
let name = Fmt.str "m%d" n in
env.memory <- Some name;
env.next_memory <- succ n;
name
| Some _ -> failwith "a memory already exists"
| Some _ -> assert false

let add_type env typ =
let n = env.next_type in
let name = Format.sprintf "ty%d" n in
let name = Fmt.str "ty%d" n in
env.types <- (name, typ) :: env.types;
env.next_type <- succ n;
name

let add_elem env typ =
let n = env.next_elem in
let name = Format.sprintf "e%d" n in
let name = Fmt.str "e%d" n in
env.elems <- (name, typ) :: env.elems;
env.next_elem <- succ n;
name

let add_table env typ =
let n = env.next_table in
let name = Format.sprintf "t%d" n in
let name = Fmt.str "t%d" n in
env.tables <- (name, typ) :: env.tables;
env.next_table <- succ n;
name

let add_global env typ =
let n = env.next_global in
let name = Format.sprintf "g%d" n in
let name = Fmt.str "g%d" n in
env.globals <- (name, typ) :: env.globals;
env.next_global <- succ n;
name

let add_local env typ =
let n = env.next_local in
let name = Format.sprintf "l%d" n in
let name = Fmt.str "l%d" n in
env.locals <- (name, typ) :: env.locals;
env.next_local <- succ n;
name

let add_block env typ bkind =
let n = env.next_block in
let name = Format.sprintf "b%d" n in
let name = Fmt.str "b%d" n in
env.blocks <- (bkind, name, typ) :: env.blocks;
env.next_block <- succ n;
name

let add_func env typ =
let n = env.next_fun in
let name = Format.sprintf "f%d" n in
let name = Fmt.str "f%d" n in
env.next_fun <- succ n;
env.funcs <- (name, typ) :: env.funcs;
name
@@ -131,15 +131,15 @@ let get_globals ntyp env ~only_mut =
let is_typ global =
let _, (m, v) = global in
match v with
| Num_type nt -> nt = ntyp && ((not only_mut) || m = Owi.Types.Var)
| Num_type nt -> num_type_eq ntyp nt && ((not only_mut) || is_mut m)
| Ref_type _ -> false
in
List.filter is_typ env.globals

let get_locals ntyp env =
let is_typ local =
let _, v = local in
match v with Num_type nt -> nt = ntyp | Ref_type _ -> false
match v with Num_type nt -> num_type_eq nt ntyp | Ref_type _ -> false
in
List.filter is_typ env.locals

10 changes: 6 additions & 4 deletions test/fuzz/interprets.ml
Original file line number Diff line number Diff line change
@@ -19,10 +19,12 @@ let set =
let raise n = if n = -2 then raise Timeout in
fun () ->
Sys.set_signal Sys.sigalrm (Sys.Signal_handle raise);
ignore
@@ ( Unix.setitimer Unix.ITIMER_REAL
{ Unix.it_interval = 0.; Unix.it_value = Param.max_time_execution }
: Unix.interval_timer_status )
let _ : Unix.interval_timer_status =
( Unix.setitimer Unix.ITIMER_REAL
{ Unix.it_interval = 0.; Unix.it_value = Param.max_time_execution }
: Unix.interval_timer_status )
in
()

let timeout_call_run (run : unit -> unit Result.t) : 'a Result.t =
try
4 changes: 2 additions & 2 deletions test/fuzz/type_stack.ml
Original file line number Diff line number Diff line change
@@ -21,8 +21,8 @@ let rec is_stack_compatible st1 st2 =
match (st1, st2) with
| _, [] -> true
| [], _ -> false
| s1 :: st1, s2 :: st2 -> s1 = s2 && is_stack_compatible st1 st2
| s1 :: st1, s2 :: st2 -> val_type_eq s1 s2 && is_stack_compatible st1 st2

let is_stack_compatible_param stack pt =
let s = List.map (fun p -> snd p) pt in
let s = List.map snd pt in
is_stack_compatible stack s
Loading