diff options
author | letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2011-03-17 21:46:47 +0000 |
---|---|---|
committer | letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2011-03-17 21:46:47 +0000 |
commit | e3c880264bf54083b962d41a4c6e1ef35ca464f2 (patch) | |
tree | 4596a3e72fb728362ae13832e8597ef007a3635e /library/goptions.ml | |
parent | ce5a3cd114d3a570cdd569e65f1a2a71f81c39f4 (diff) |
Goptions: repair Unset for int options
Previous code was trying to do a bool write, and in case of error,
a int write. But for compatibility reason, bool write error were
turned into warnings, preventing Unset Foo Bar to work when
Foo Bar is an int option.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13915 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'library/goptions.ml')
-rw-r--r-- | library/goptions.ml | 40 |
1 files changed, 29 insertions, 11 deletions
diff --git a/library/goptions.ml b/library/goptions.ml index e047ab9a0..fbce68fad 100644 --- a/library/goptions.ml +++ b/library/goptions.ml @@ -303,19 +303,37 @@ let set_option_value locality check_and_cast key v = let bad_type_error () = error "Bad type of value for this option." -let set_int_option_value_gen locality = set_option_value locality - (fun v -> function - | (IntValue _) -> IntValue v - | _ -> bad_type_error ()) +let check_int_value v = function + | IntValue _ -> IntValue v + | _ -> bad_type_error () + +let check_bool_value v = function + | BoolValue _ -> BoolValue v + | _ -> bad_type_error () + +let check_string_value v = function + | StringValue _ -> StringValue v + | _ -> bad_type_error () + +let check_unset_value v = function + | BoolValue _ -> BoolValue false + | IntValue _ -> IntValue None + | _ -> bad_type_error () + +(* Nota: For compatibility reasons, some errors are treated as + warning. This allows a script to refer to an option that doesn't + exist anymore *) + +let set_int_option_value_gen locality = + set_option_value locality check_int_value let set_bool_option_value_gen locality key v = - try set_option_value locality (fun v -> function - | (BoolValue _) -> BoolValue v - | _ -> bad_type_error ()) key v + try set_option_value locality check_bool_value key v + with UserError (_,s) -> Flags.if_verbose msg_warning s +let set_string_option_value_gen locality = + set_option_value locality check_string_value +let unset_option_value_gen locality key = + try set_option_value locality check_unset_value key () with UserError (_,s) -> Flags.if_verbose msg_warning s -let set_string_option_value_gen locality = set_option_value locality - (fun v -> function - | (StringValue _) -> StringValue v - | _ -> bad_type_error ()) let set_int_option_value = set_int_option_value_gen None let set_bool_option_value = set_bool_option_value_gen None |