blob: d93c36577b1d5259d636ca4d4d23fd6f234bbd69 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
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 st = Ast.LAYER_value in
decl (MOD_ITEM_type (st, 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 $RBUILD 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
* End:
*)
|