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