Add beginnings of a fuzzer to rustboot.

Author: graydon

src/Makefile

@@ -236,7 +236,7 @@ ME_MLS := $(addprefix boot/me/, walk.ml semant.ml resolve.ml alias.ml \
             type.ml dead.ml effect.ml typestate.ml loop.ml layout.ml  \
             transutil.ml trans.ml dwarf.ml)
 FE_MLS := $(addprefix boot/fe/, ast.ml token.ml lexer.ml parser.ml pexp.ml \
-            item.ml cexp.ml)
+            item.ml cexp.ml fuzz.ml)
 DRIVER_TOP_MLS := $(addprefix boot/driver/, lib.ml $(VARIANT)/glue.ml main.ml)
 
 BOOT_MLS := $(UTIL_BOT_MLS) $(DRIVER_BOT_MLS) $(FE_MLS) $(IL_MLS) $(ME_MLS) \

src/boot/driver/main.ml

@@ -60,6 +60,7 @@ let (sess:Session.sess) =
     Session.sess_report_gc = false;
     Session.sess_report_deps = false;
     Session.sess_next_crate_id = 0;
+    Session.sess_fuzz_item_count = 5;
     Session.sess_timings = Hashtbl.create 0;
     Session.sess_lib_dirs = Queue.create ();
     Session.sess_crate_meta = Hashtbl.create 0;
@@ -219,6 +220,15 @@ let argspecs =
     (flag (fun _ -> sess.Session.sess_use_pexps <- true)
        "-pexp"         "use pexp portion of AST");
 
+    ("-zc", Arg.Int (fun i -> sess.Session.sess_fuzz_item_count <- i),
+     "count of items to generate when fuzzing");
+
+    ("-zs", Arg.Int (fun i -> Fuzz.fuzz (Some i) sess),
+     "run fuzzer with given seed");
+
+    (flag (fun _ -> Fuzz.fuzz None sess)
+       "-z" "run fuzzer with random seed")
+
   ] @ (Glue.alt_argspecs sess)
 ;;
 

src/boot/driver/session.ml

@@ -45,6 +45,7 @@ type sess =
   mutable sess_report_gc: bool;
   mutable sess_report_deps: bool;
   mutable sess_next_crate_id: int;
+  mutable sess_fuzz_item_count: int;
   sess_timings: (string, float) Hashtbl.t;
   sess_spans: (node_id,span) Hashtbl.t;
   sess_lib_dirs: filename Queue.t;

src/boot/fe/fuzz.ml

@@ -0,0 +1,166 @@
+open Common;;
+open Ast;;
+
+let ident_chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_";;
+let digit_chars = "1234567890";;
+
+type scope =
+    SCOPE_crate of crate
+  | SCOPE_mod_item of (ident * mod_item)
+  | SCOPE_block of block
+  | SCOPE_anon
+;;
+
+type ctxt =
+    {
+      ctxt_scopes: scope Stack.t;
+      ctxt_node_counter: int ref;
+      ctxt_sess: Session.sess;
+    }
+
+let generate_ident _ : ident =
+  let char n =
+    if n = 0
+    then '_'
+    else ident_chars.[Random.int (String.length ident_chars)]
+  in
+  let i = 3 + (Random.int 10) in
+  let s = String.create i in
+    for j = 0 to (i-1)
+    do
+      s.[j] <- char j
+    done;
+    s
+;;
+
+let wrap (n:'a) (cx:ctxt) : 'a identified =
+  incr cx.ctxt_node_counter;
+  { node = n; id = Node (!(cx.ctxt_node_counter)) }
+;;
+
+let generate_in (scope:scope) (fn:(ctxt -> 'a)) (cx:ctxt) : 'a =
+  Stack.push scope cx.ctxt_scopes;
+  let x = fn cx in
+    ignore (Stack.pop cx.ctxt_scopes);
+    x
+;;
+
+let generate_some (fn:(ctxt -> 'a)) (cx:ctxt) : 'a array =
+  let root_count = cx.ctxt_sess.Session.sess_fuzz_item_count in
+  let depth = Stack.length cx.ctxt_scopes in
+  if depth >= root_count
+  then [| |]
+  else
+    Array.init (1 + (Random.int (root_count - depth)))
+      (fun _ -> fn cx)
+;;
+
+let rec generate_ty (cx:ctxt) : ty =
+  let subty _ =
+    generate_in SCOPE_anon
+      generate_ty cx
+  in
+    match Random.int (if Random.bool() then 10 else 17) with
+      0 -> TY_nil
+    | 1 -> TY_bool
+
+    | 2 -> TY_mach TY_u8
+    | 3 -> TY_mach TY_u32
+
+    | 4 -> TY_mach TY_i8
+    | 5 -> TY_mach TY_i32
+
+    | 6 -> TY_int
+    | 7 -> TY_uint
+    | 8 -> TY_char
+    | 9 -> TY_str
+
+    | 10 -> TY_tup (generate_in SCOPE_anon
+                      (generate_some
+                         generate_ty) cx)
+    | 11 -> TY_vec (subty())
+    | 12 ->
+        let generate_elt cx =
+          (generate_ident cx, generate_ty cx)
+        in
+          TY_rec (generate_in SCOPE_anon
+                    (generate_some generate_elt) cx)
+
+    | 13 -> TY_chan (subty())
+    | 14 -> TY_port (subty())
+
+    | 15 -> TY_task
+
+    | _ -> TY_box (subty())
+;;
+
+
+let rec generate_mod_item (mis:mod_items) (cx:ctxt) : unit =
+  let ident = generate_ident () in
+  let decl i = wrap { decl_item = i;
+                      decl_params = [| |] } cx
+  in
+  let item =
+    match Random.int 2 with
+        0 ->
+          let ty = generate_ty cx in
+          let eff = PURE in
+            decl (MOD_ITEM_type (eff, ty))
+      | _ ->
+          let mis' = Hashtbl.create 0 in
+          let view = { view_imports = Hashtbl.create 0;
+                       view_exports = Hashtbl.create 0; }
+          in
+          let item =
+            decl (MOD_ITEM_mod (view, mis'))
+          in
+          let scope =
+            SCOPE_mod_item (ident, item)
+          in
+            ignore
+              (generate_in scope
+                 (generate_some (generate_mod_item mis'))
+                 cx);
+            item
+  in
+    Hashtbl.add mis ident item
+;;
+
+let fuzz (seed:int option) (sess:Session.sess) : unit =
+  begin
+    match seed with
+        None -> Random.self_init ()
+      | Some s -> Random.init s
+  end;
+  let filename =
+    match sess.Session.sess_out with
+        Some o -> o
+      | None ->
+          match seed with
+              None -> "fuzz.rs"
+            | Some seed -> "fuzz-" ^ (string_of_int seed) ^ ".rs"
+  in
+  let out = open_out_bin filename in
+  let ff = Format.formatter_of_out_channel out in
+  let cx = { ctxt_scopes = Stack.create ();
+             ctxt_node_counter = ref 0;
+             ctxt_sess = sess }
+  in
+  let mis = Hashtbl.create 0 in
+    ignore (generate_some
+              (generate_mod_item mis) cx);
+    fmt_mod_items ff mis;
+    Format.pp_print_flush ff ();
+    close_out out;
+    exit 0
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)