From 33962967111fbed55e93260b12cd65e372a0958a Mon Sep 17 00:00:00 2001

From: "Richard W.M. Jones" <rjones@redhat.com>

Date: Sat, 9 Nov 2013 09:11:30 +0000

Subject: [PATCH 08/11] stdlib: arg: Allow flags such as --flag=arg as well as

 --flag arg.

Fix for the following issue:

http://caml.inria.fr/mantis/view.php?id=5197

---

 stdlib/arg.ml  | 85 ++++++++++++++++++++++++++++++++++------------------------

 stdlib/arg.mli |  3 ++-

 2 files changed, 52 insertions(+), 36 deletions(-)

diff --git a/stdlib/arg.ml b/stdlib/arg.ml

index 8b64236..d94b75f 100644

--- a/stdlib/arg.ml

+++ b/stdlib/arg.ml

@@ -55,6 +55,12 @@ let rec assoc3 x l =

   | _ :: t -> assoc3 x t

 ;;

+let split s =

+  let i = String.index s '=' in

+  let len = String.length s in

+  String.sub s 0 i, String.sub s (i+1) (len-(i+1))

+;;

+

 let make_symlist prefix sep suffix l =

   match l with

   | [] -> "<none>"

@@ -130,73 +136,82 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =

   while !current < l do

     let s = argv.(!current) in

     if String.length s >= 1 && String.get s 0 = '-' then begin

-      let action =

-        try assoc3 s !speclist

-        with Not_found -> stop (Unknown s)

+      let action, follow =

+        try assoc3 s !speclist, None

+        with Not_found ->

+          try

+            let keyword, arg = split s in

+            assoc3 keyword !speclist, Some arg

+          with Not_found -> stop (Unknown s)

+      in

+      let no_arg () =

+        match follow with

+        | None -> ()

+        | Some arg -> stop (Wrong (s, arg, "no argument"))

+      in

+      let get_arg () =

+        match follow with

+        | None ->

+          if !current + 1 < l then begin

+            incr current;

+            argv.(!current)

+          end

+          else stop (Missing s)

+        | Some arg -> arg

       in

       begin try

         let rec treat_action = function

-        | Unit f -> f ();

-        | Bool f when !current + 1 < l ->

-            let arg = argv.(!current + 1) in

+        | Unit f -> no_arg (); f ();

+        | Bool f ->

+            let arg = get_arg () in

             begin try f (bool_of_string arg)

             with Invalid_argument "bool_of_string" ->

                    raise (Stop (Wrong (s, arg, "a boolean")))

             end;

-            incr current;

-        | Set r -> r := true;

-        | Clear r -> r := false;

-        | String f when !current + 1 < l ->

-            f argv.(!current + 1);

-            incr current;

-        | Symbol (symb, f) when !current + 1 < l ->

-            let arg = argv.(!current + 1) in

+        | Set r -> no_arg (); r := true;

+        | Clear r -> no_arg (); r := false;

+        | String f ->

+            f (get_arg ());

+        | Symbol (symb, f) ->

+            let arg = get_arg () in

             if List.mem arg symb then begin

-              f argv.(!current + 1);

-              incr current;

+              f arg;

             end else begin

               raise (Stop (Wrong (s, arg, "one of: "

                                           ^ (make_symlist "" " " "" symb))))

             end

-        | Set_string r when !current + 1 < l ->

-            r := argv.(!current + 1);

-            incr current;

-        | Int f when !current + 1 < l ->

-            let arg = argv.(!current + 1) in

+        | Set_string r ->

+            r := get_arg ();

+        | Int f ->

+            let arg = get_arg () in

             begin try f (int_of_string arg)

             with Failure "int_of_string" ->

                    raise (Stop (Wrong (s, arg, "an integer")))

             end;

-            incr current;

-        | Set_int r when !current + 1 < l ->

-            let arg = argv.(!current + 1) in

+        | Set_int r ->

+            let arg = get_arg () in

             begin try r := (int_of_string arg)

             with Failure "int_of_string" ->

                    raise (Stop (Wrong (s, arg, "an integer")))

             end;

-            incr current;

-        | Float f when !current + 1 < l ->

-            let arg = argv.(!current + 1) in

+        | Float f ->

+            let arg = get_arg () in

             begin try f (float_of_string arg);

             with Failure "float_of_string" ->

                    raise (Stop (Wrong (s, arg, "a float")))

             end;

-            incr current;

-        | Set_float r when !current + 1 < l ->

-            let arg = argv.(!current + 1) in

+        | Set_float r ->

+            let arg = get_arg () in

             begin try r := (float_of_string arg);

             with Failure "float_of_string" ->

                    raise (Stop (Wrong (s, arg, "a float")))

             end;

-            incr current;

         | Tuple specs ->

             List.iter treat_action specs;

         | Rest f ->

             while !current < l - 1 do

-              f argv.(!current + 1);

-              incr current;

-            done;

-        | _ -> raise (Stop (Missing s))

+              f (get_arg ());

+            done

         in

         treat_action action

       with Bad m -> stop (Message m);

diff --git a/stdlib/arg.mli b/stdlib/arg.mli

index 869d030..b8c6f11 100644

--- a/stdlib/arg.mli

+++ b/stdlib/arg.mli

@@ -25,7 +25,8 @@

     [Unit], [Set] and [Clear] keywords take no argument. A [Rest]

     keyword takes the remaining of the command line as arguments.

     Every other keyword takes the following word on the command line

-    as argument.

+    as argument.  For compatibility with GNU getopt_long, [keyword=arg]

+    is also allowed.

     Arguments not preceded by a keyword are called anonymous arguments.

    Examples ([cmd] is assumed to be the command name):

-- 

1.8.4.2