From 62ba47c9058858db66fc7ed7167d55e5990bc567 Mon Sep 17 00:00:00 2001 From: redianthus Date: Wed, 22 Apr 2026 11:22:11 +0200 Subject: [PATCH 1/2] add basic dumb dictionnary --- src/dune | 2 + src/fuzz/fuzz_dict.ml | 155 +++++++++++++++++++++++++++++ src/fuzz/fuzz_driver.ml | 23 ++++- src/fuzz/fuzz_gen.ml | 69 +++++++++++++ src/fuzz/fuzz_wasm_ffi.ml | 34 +------ test/cram/fuzz/basic.t/run.t | 2 +- test/cram/fuzz/rounds.t/rounds.wat | 6 +- test/cram/fuzz/rounds.t/run.t | 2 +- 8 files changed, 254 insertions(+), 39 deletions(-) create mode 100644 src/fuzz/fuzz_dict.ml create mode 100644 src/fuzz/fuzz_gen.ml diff --git a/src/dune b/src/dune index d61cf8ae2..c962ef15e 100644 --- a/src/dune +++ b/src/dune @@ -64,7 +64,9 @@ fop_intf f32_intf f64_intf + fuzz_dict fuzz_driver + fuzz_gen fuzz_state fuzz_wasm_ffi global_intf diff --git a/src/fuzz/fuzz_dict.ml b/src/fuzz/fuzz_dict.ml new file mode 100644 index 000000000..d9117ea8f --- /dev/null +++ b/src/fuzz/fuzz_dict.ml @@ -0,0 +1,155 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) +(* Copyright © 2021-2024 OCamlPro *) +(* Written by the Owi programmers *) + +let i32 = + [| (************************* limit cases and magic *************) + 0l + ; 1l + ; 17l + ; 42l + ; 666l + ; 123456l + ; Int32.min_int + ; Int32.max_int + ; (************************* 2^n *******************************) + 2l + ; 4l + ; 8l + ; 16l + ; 32l + ; 64l + ; 128l + ; 256l + ; 512l + ; 1024l + ; 2048l + ; 4096l + ; 8192l + ; 16384l + ; 32768l + ; 65536l + ; 131072l + ; 262144l + ; 524288l + ; 1048576l + ; 2097152l + ; 4194304l + ; 8388608l + ; 16777216l + ; 33554432l + ; 67108864l + ; 134217728l + ; 268435456l + ; 536870912l + ; 1073741824l + ; 2147483648l + |] + +let i64 = + [| (************************* limit cases and magic *************) + 0L + ; 1L + ; 17L + ; 42L + ; 666L + ; 123456L + ; Int64.min_int + ; Int64.max_int + ; (************************* 2^n *******************************) + 2L + ; 4L + ; 8L + ; 16L + ; 32L + ; 64L + ; 128L + ; 256L + ; 512L + ; 1024L + ; 2048L + ; 4096L + ; 8192L + ; 16384L + ; 32768L + ; 65536L + ; 131072L + ; 262144L + ; 524288L + ; 1048576L + ; 2097152L + ; 4194304L + ; 8388608L + ; 16777216L + ; 33554432L + ; 67108864L + ; 134217728L + ; 268435456L + ; 536870912L + ; 1073741824L + ; 2147483648L + ; 4294967296L + ; 8589934592L + ; 17179869184L + ; 34359738368L + ; 68719476736L + ; 137438953472L + ; 274877906944L + ; 549755813888L + ; 1099511627776L + ; 2199023255552L + ; 4398046511104L + ; 8796093022208L + ; 17592186044416L + ; 35184372088832L + ; 70368744177664L + ; 140737488355328L + ; 281474976710656L + ; 562949953421312L + ; 1125899906842624L + ; 2251799813685248L + ; 4503599627370496L + ; 9007199254740992L + ; 18014398509481984L + ; 36028797018963968L + ; 72057594037927936L + ; 144115188075855872L + ; 288230376151711744L + ; 576460752303423488L + ; 1152921504606846976L + ; 2305843009213693952L + ; 4611686018427387904L + |] + +let f32 = + (* TODO: avoid going through 64bits floats *) + Array.map Concrete_f32.of_float + [| (************************* limit cases and magic ***********) + 0. + ; -0. + ; Float.one + ; Float.infinity + ; Float.nan + ; Float.signaling_nan + ; Float.quiet_nan + ; Float.pi + ; Float.max_float + ; Float.min_float + ; Float.epsilon + |] + +let f64 = + Array.map Concrete_f64.of_float + [| (************************* limit cases and magic ***********) + 0. + ; -0. + ; Float.one + ; Float.infinity + ; Float.nan + ; Float.signaling_nan + ; Float.quiet_nan + ; Float.pi + ; Float.max_float + ; Float.min_float + ; Float.epsilon + |] diff --git a/src/fuzz/fuzz_driver.ml b/src/fuzz/fuzz_driver.ml index bebd6ecd7..511aca0f4 100644 --- a/src/fuzz/fuzz_driver.ml +++ b/src/fuzz/fuzz_driver.ml @@ -1,6 +1,10 @@ let pp_model ppf model = Fmt.list ~sep:(fun ppf () -> Fmt.pf ppf " ; ") Concrete_value.pp ppf model +let found_bug e = + Log.app (fun m -> m "Found a bug with model: %a" pp_model !Fuzz_state.model); + e + let rec run ~rounds f = match f () with | Ok () -> @@ -10,6 +14,19 @@ let rec run ~rounds f = | Some 0 -> Ok () | Some n -> run ~rounds:(Some (pred n)) f end - | Error _ as e -> - Log.app (fun m -> m "Found a bug with model: %a" pp_model !Fuzz_state.model); - e + | Error _ as e -> found_bug e + +let run ~rounds f = + (* First run where we stop early if no symbol is created *) + match f () with + | Ok () -> + begin match !Fuzz_state.model with + | [] -> + (* no symbol found, the next run will be the exact same, no need to go further! *) + Ok () + | _nonempty_model -> + (* enter the real fuzzing loop *) + let rounds = Option.map pred rounds in + run ~rounds f + end + | Error _ as e -> found_bug e diff --git a/src/fuzz/fuzz_gen.ml b/src/fuzz/fuzz_gen.ml new file mode 100644 index 000000000..70e2c31f9 --- /dev/null +++ b/src/fuzz/fuzz_gen.ml @@ -0,0 +1,69 @@ +let i32 () = + let use_dict = Random.bool () in + let n = + if use_dict then begin + let n = Random.int (Array.length Fuzz_dict.i32) in + Fuzz_dict.i32.(n) + end + else begin + let n = Random.bits32 () in + Concrete_i32.of_int32 n + end + in + Fuzz_state.model := Concrete_value.I32 n :: !Fuzz_state.model; + n + +let i64 () = + let use_dict = Random.bool () in + let n = + if use_dict then begin + let n = Random.int (Array.length Fuzz_dict.i64) in + Fuzz_dict.i64.(n) + end + else begin + let n = Random.bits64 () in + Concrete_i64.of_int64 n + end + in + Fuzz_state.model := Concrete_value.I64 n :: !Fuzz_state.model; + n + +let f32 () = + let use_dict = Random.bool () in + let n = + if use_dict then begin + let n = Random.int (Array.length Fuzz_dict.f32) in + Fuzz_dict.f32.(n) + end + else begin + (* TODO: avoid going through 64 bits *) + let n = Random.bits64 () in + let n = Int64.float_of_bits n in + Concrete_f32.of_float n + end + in + Fuzz_state.model := Concrete_value.F32 n :: !Fuzz_state.model; + n + +let f64 () = + let use_dict = Random.bool () in + let n = + if use_dict then begin + let n = Random.int (Array.length Fuzz_dict.f64) in + Fuzz_dict.f64.(n) + end + else begin + let n = Random.bits64 () in + let n = Int64.float_of_bits n in + Concrete_f64.of_float n + end + in + Fuzz_state.model := Concrete_value.F64 n :: !Fuzz_state.model; + n + +let v128 () = + let n1 = Random.bits64 () in + let n2 = Random.bits64 () in + let n = Concrete_v128.of_i64x2 n1 n2 in + Fuzz_state.model := Concrete_value.V128 n :: !Fuzz_state.model; + n diff --git a/src/fuzz/fuzz_wasm_ffi.ml b/src/fuzz/fuzz_wasm_ffi.ml index 3a76d1cbf..061236cc4 100644 --- a/src/fuzz/fuzz_wasm_ffi.ml +++ b/src/fuzz/fuzz_wasm_ffi.ml @@ -14,39 +14,15 @@ module M : let symbol_invisible_bool () = Ok (if Random.bool () then 1l else 0l) - let symbol_i32 () = - let n = Random.bits32 () in - let n = Concrete_i32.of_int32 n in - Fuzz_state.model := Concrete_value.I32 n :: !Fuzz_state.model; - Ok n + let symbol_i32 () = Ok (Fuzz_gen.i32 ()) - let symbol_i64 () = - let n = Random.bits64 () in - let n = Concrete_i64.of_int64 n in - Fuzz_state.model := Concrete_value.I64 n :: !Fuzz_state.model; - Ok n + let symbol_i64 () = Ok (Fuzz_gen.i64 ()) - let symbol_f32 () = - (* TODO: avoid going through 64 bits *) - let n = Random.bits64 () in - let n = Int64.float_of_bits n in - let n = Concrete_f32.of_float n in - Fuzz_state.model := Concrete_value.F32 n :: !Fuzz_state.model; - Ok n + let symbol_f32 () = Ok (Fuzz_gen.f32 ()) - let symbol_f64 () = - let n = Random.bits64 () in - let n = Int64.float_of_bits n in - let n = Concrete_f64.of_float n in - Fuzz_state.model := Concrete_value.F64 n :: !Fuzz_state.model; - Ok n + let symbol_f64 () = Ok (Fuzz_gen.f64 ()) - let symbol_v128 () = - let n1 = Random.bits64 () in - let n2 = Random.bits64 () in - let n = Concrete_v128.of_i64x2 n1 n2 in - Fuzz_state.model := Concrete_value.V128 n :: !Fuzz_state.model; - Ok n + let symbol_v128 () = Ok (Fuzz_gen.v128 ()) let abort () = (* TODO: stop the round properly *) diff --git a/test/cram/fuzz/basic.t/run.t b/test/cram/fuzz/basic.t/run.t index d0b5d8d30..c6d32c3ba 100644 --- a/test/cram/fuzz/basic.t/run.t +++ b/test/cram/fuzz/basic.t/run.t @@ -1,4 +1,4 @@ $ owi fuzz basic.wat - Found a bug with model: i32.const -1171539784 + Found a bug with model: i32.const -1757994328 owi: [ERROR] unreachable [96] diff --git a/test/cram/fuzz/rounds.t/rounds.wat b/test/cram/fuzz/rounds.t/rounds.wat index fb50f9498..893c6e1a8 100644 --- a/test/cram/fuzz/rounds.t/rounds.wat +++ b/test/cram/fuzz/rounds.t/rounds.wat @@ -2,11 +2,7 @@ (import "owi" "i32_symbol" (func $i32_symbol (result i32))) (func $start call $i32_symbol - i32.const 42 - i32.eq - (if (then - unreachable - )) + drop ) (start $start) ) diff --git a/test/cram/fuzz/rounds.t/run.t b/test/cram/fuzz/rounds.t/run.t index 4a551db7a..2dbc9d7d6 100644 --- a/test/cram/fuzz/rounds.t/run.t +++ b/test/cram/fuzz/rounds.t/run.t @@ -1 +1 @@ - $ owi fuzz rounds.wat --rounds 10000 + $ owi fuzz rounds.wat --rounds 100 From f2a20a8568b031d43698c9f9dc3efcaa59740c4d Mon Sep 17 00:00:00 2001 From: redianthus Date: Wed, 22 Apr 2026 17:03:39 +0200 Subject: [PATCH 2/2] better dict by reading constant value from the body of functions --- src/fuzz/fuzz_dict.ml | 67 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/src/fuzz/fuzz_dict.ml b/src/fuzz/fuzz_dict.ml index d9117ea8f..62d623e78 100644 --- a/src/fuzz/fuzz_dict.ml +++ b/src/fuzz/fuzz_dict.ml @@ -153,3 +153,70 @@ let f64 = ; Float.min_float ; Float.epsilon |] + +module Collect = struct + type t = + { i32 : Concrete_i32.t list + ; i64 : Concrete_i64.t list + ; f32 : Concrete_f32.t list + ; f64 : Concrete_f64.t list + } + + let empty = { i32 = []; i64 = []; f32 = []; f64 = [] } + + let rec from_instr collect instr = + match instr.Annotated.raw with + | Binary.I32 (Const n) -> { collect with i32 = n :: collect.i32 } + | I64 (Const n) -> { collect with i64 = n :: collect.i64 } + | F32 (Const n) -> { collect with f32 = n :: collect.f32 } + | F64 (Const n) -> { collect with f64 = n :: collect.f64 } + | Block (_, _, e) | Loop (_, _, e) -> from_expr collect e + | If_else (_, _, e1, e2) -> + let collect = from_expr collect e1 in + from_expr collect e2 + | I32 _ | I64 _ | F32 _ | F64 _ | V128 _ | I8x16 _ | I16x8 _ | I32x4 _ + | I64x2 _ | Ref _ | Local _ | Global _ | Table _ | Elem _ | Memory _ + | Data _ | Drop | Select _ | Nop | Unreachable | Br _ | Br_if _ | Br_table _ + | Br_on_null _ | Br_on_non_null _ | Return | Return_call _ + | Return_call_ref _ | Return_call_indirect _ | Call _ | Call_indirect _ + | Call_ref _ -> + collect + + and from_expr collect expr = + List.fold_left from_instr collect expr.Annotated.raw + + let from_global _globals _collect = raise @@ Failure "TODO" + + let from_table _tables _collect = raise @@ Failure "TODO" + + let from_mem _memories _collect = raise @@ Failure "TODO" + + let from_func funcs collect = + Array.fold_left + (fun collect -> function + | Origin.Imported _ -> raise @@ Failure "TODO" + | Local { Binary.Func.body; type_f = _; locals = _; id = _ } -> + from_expr collect body ) + collect funcs + + let from_elem _elem _collect = raise @@ Failure "TODO" + + let from_data _data _collect = raise @@ Failure "TODO" + + let from_module + { Binary.Module.id = _ + ; types = _ + ; global + ; table + ; mem + ; func + ; tag = _ + ; elem + ; data + ; exports = _ + ; start = _ + ; custom = _ + } = + empty |> from_global global |> from_table table |> from_mem mem + |> from_func func |> from_elem elem |> from_data data +end