1let current = ref 0;;
2
3let accum = ref [];;
4
5let record fmt (* args *) =
6  Printf.kprintf (fun s -> accum := s :: !accum) fmt
7;;
8
9let f_unit () = record "unit()";;
10let f_bool b = record "bool(%b)" b;;
11let r_set = ref false;;
12let r_clear = ref true;;
13let f_string s = record "string(%s)" s;;
14let r_string = ref "";;
15let f_int i = record "int(%d)" i;;
16let r_int = ref 0;;
17let f_float f = record "float(%g)" f;;
18let r_float = ref 0.0;;
19let f_symbol s = record "symbol(%s)" s;;
20let f_rest s = record "rest(%s)" s;;
21let f_anon s = record "anon(%s)" s;;
22
23let spec = Arg.[
24  "-u", Unit f_unit, "Unit (0)";
25  "-b", Bool f_bool, "Bool (1)";
26  "-s", Set r_set, "Set (0)";
27  "-c", Clear r_clear, "Clear (0)";
28  "-str", String f_string, "String (1)";
29  "-sstr", Set_string r_string, "Set_string (1)";
30  "-i", Int f_int, "Int (1)";
31  "-si", Set_int r_int, "Set_int (1)";
32  "-f", Float f_float, "Float (1)";
33  "-sf", Set_float r_float, "Set_float (1)";
34  "-t", Tuple [Bool f_bool; String f_string; Int f_int], "Tuple (3)";
35  "-sym", Symbol (["a"; "b"; "c"], f_symbol), "Symbol (1)";
36  "-rest", Rest f_rest, "Rest (*)";
37];;
38
39let args1 = [|
40  "prog";
41  "anon1";
42  "-u";
43  "-b"; "true";
44  "-s";
45  "anon2";
46  "-c";
47  "-str"; "foo";
48  "-sstr"; "bar";
49  "-i"; "19";
50  "-si"; "42";
51  "-f"; "3.14";
52  "-sf"; "2.72";
53  "anon3";
54  "-t"; "false"; "gee"; "1436";
55  "-sym"; "c";
56  "anon4";
57  "-rest"; "r1"; "r2";
58|];;
59
60let args2 = [|
61  "prog";
62  "anon1";
63  "-u";
64  "-b=true";
65  "-s";
66  "anon2";
67  "-c";
68  "-str=foo";
69  "-sstr=bar";
70  "-i=19";
71  "-si=42";
72  "-f=3.14";
73  "-sf=2.72";
74  "anon3";
75  "-t"; "false"; "gee"; "1436";
76  "-sym=c";
77  "anon4";
78  "-rest"; "r1"; "r2";
79|];;
80
81let error s = Printf.printf "error (%s)\n" s;;
82let check r v msg = if !r <> v then error msg;;
83
84let test spec argv =
85  current := 0;
86  r_set := false;
87  r_clear := true;
88  r_string := "";
89  r_int := 0;
90  r_float := 0.0;
91  accum := [];
92  Arg.parse_and_expand_argv_dynamic current argv (ref spec) f_anon "usage";
93  let result = List.rev !accum in
94  let reference = [
95      "anon(anon1)";
96      "unit()";
97      "bool(true)";
98      "anon(anon2)";
99      "string(foo)";
100      "int(19)";
101      "float(3.14)";
102      "anon(anon3)";
103      "bool(false)"; "string(gee)"; "int(1436)";
104      "symbol(c)";
105      "anon(anon4)";
106      "rest(r1)"; "rest(r2)";
107    ]
108  in
109  if result <> reference then begin
110    let f x y =
111      Printf.printf "%20s %c %-20s\n%!" x (if x = y then '=' else '#') y
112    in
113    List.iter2 f result reference;
114  end;
115  check r_set true "Set";
116  check r_clear false "Clear";
117  check r_string "bar" "Set_string";
118  check r_int 42 "Set_int";
119  check r_float 2.72 "Set_float";
120;;
121
122let test_arg args = test spec (ref args);;
123
124test_arg args1;;
125test_arg args2;;
126
127
128let safe_rm file =
129  try
130    Sys.remove file
131  with _ -> ()
132
133let test_rw argv =
134  safe_rm "test_rw";
135  safe_rm "test_rw0";
136  Arg.write_arg "test_rw" argv;
137  Arg.write_arg0 "test_rw0" argv;
138  let argv' = Arg.read_arg "test_rw" in
139  let argv0 = Arg.read_arg0 "test_rw0" in
140  let f x y =
141    if x <> y then
142      Printf.printf "%20s %c %-20s\n%!" x (if x = y then '=' else '#') y
143  in
144  Array.iter2 f argv argv';
145  Array.iter2 f argv argv0;
146  safe_rm "test_rw";
147  safe_rm "test_rw0";
148;;
149
150test_rw args1;;
151test_rw args2;;
152test_rw (Array.make 0 "");;
153test_rw [|"";""|];;
154
155let f_expand r msg arg s =
156  if s <> r then error msg;
157  arg;
158;;
159
160let expand1,args1,expected1 =
161  let l = Array.length args1  - 1 in
162  let args = Array.sub args1 1 l in
163  let args1 =  [|"prog";"-expand";"expand_arg1"|] in
164  Arg.["-expand", Expand (f_expand "expand_arg1" "Expand" args), "Expand (1)";],
165  args1,
166  Array.append  args1 args
167;;
168
169let expand2,args2,expected2 =
170  let l = Array.length args2  - 1 in
171  let args = Array.sub args2 1 l in
172  let args2 = [|"prog";"-expand";"expand_arg2"|] in
173  Arg.["-expand", Expand (f_expand "expand_arg2" "Expand" args), "Expand (1)";],
174  args2,
175  Array.append args2 args
176;;
177
178let test_expand spec argv reference =
179  let result = ref argv in
180  test spec result;
181  let f x y =
182    if x <> y then
183      Printf.printf "%20s %c %-20s\n%!" x (if x = y then '=' else '#') y
184  in
185  Array.iter2 f !result reference;
186;;
187
188test_expand (expand1@spec) args1 expected1;;
189test_expand (expand2@spec) args2 expected2;;
190