Add NON-upstream (but being sent upstream) patch to allow --flag=arg

as an alternative to --flag arg (RHBZ#1028650).
This commit is contained in:
Richard W.M. Jones 2013-11-09 09:15:09 +00:00
parent 11969865cd
commit f231f651e6
2 changed files with 174 additions and 2 deletions

View File

@ -0,0 +1,165 @@
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] 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.3.1

View File

@ -1,6 +1,6 @@
Name: ocaml Name: ocaml
Version: 4.01.0 Version: 4.01.0
Release: 3%{?dist} Release: 4%{?dist}
Summary: OCaml compiler and programming environment Summary: OCaml compiler and programming environment
@ -34,6 +34,9 @@ Patch0005: 0005-configure-Allow-user-defined-C-compiler-flags.patch
Patch0006: 0006-Add-support-for-ppc64.patch Patch0006: 0006-Add-support-for-ppc64.patch
Patch0007: 0007-yacc-Use-mkstemp-instead-of-mktemp.patch Patch0007: 0007-yacc-Use-mkstemp-instead-of-mktemp.patch
# NON-upstream patch to allow '--flag=arg' as an alternative to '--flag arg'.
Patch0008: 0001-stdlib-arg-Allow-flags-such-as-flag-arg-as-well-as-f.patch
BuildRequires: ncurses-devel BuildRequires: ncurses-devel
BuildRequires: gdbm-devel BuildRequires: gdbm-devel
BuildRequires: tcl-devel BuildRequires: tcl-devel
@ -522,6 +525,10 @@ fi
%changelog %changelog
* Sat Nov 9 2013 Richard W.M. Jones <rjones@redhat.com> - 4.01.0-4
- Add NON-upstream (but being sent upstream) patch to allow --flag=arg
as an alternative to --flag arg (RHBZ#1028650).
* Sat Sep 14 2013 Richard W.M. Jones <rjones@redhat.com> - 4.01.0-3 * Sat Sep 14 2013 Richard W.M. Jones <rjones@redhat.com> - 4.01.0-3
- Disable -lcurses. This is not actually used, just linked with unnecessarily. - Disable -lcurses. This is not actually used, just linked with unnecessarily.
@ -529,7 +536,7 @@ fi
- Fix the build on ppc64. - Fix the build on ppc64.
* Fri Sep 13 2013 Richard W.M. Jones <rjones@redhat.com> - 4.01.0-1 * Fri Sep 13 2013 Richard W.M. Jones <rjones@redhat.com> - 4.01.0-1
- Update to new major version 4.01.0. - Update to new major version OCaml 4.01.0.
- Rebase patches. - Rebase patches.
- Remove bogus Requires 'ncurses-devel'. The base ocaml package already - Remove bogus Requires 'ncurses-devel'. The base ocaml package already
pulls in the library implicitly. pulls in the library implicitly.