Merge PR #8164: Add information to option type errors

3 files changed, 26 insertions, 5 deletions

diff --git a/library/goptions.ml b/library/goptions.ml
index f14ad333e9..eafcb8fea6 100644
--- a/library/goptions.ml
+++ b/library/goptions.ml
@@ -318,26 +318,35 @@ let set_option_value ?(locality = OptDefault) check_and_cast key v =
   | Some (name, depr, (read,write,append)) ->
     write locality (check_and_cast v (read ()))
 
-let bad_type_error () = user_err Pp.(str "Bad type of value for this option.")
+let show_value_type = function
+  | BoolValue _ -> "bool"
+  | IntValue _ -> "int"
+  | StringValue _ -> "string"
+  | StringOptValue _ -> "string"
+
+let bad_type_error opt_value actual_type =
+  user_err Pp.(str "Bad type of value for this option:" ++ spc() ++
+               str "expected " ++ str (show_value_type opt_value) ++
+               str ", got " ++ str actual_type ++ str ".")
 
 let check_int_value v = function
   | IntValue _ -> IntValue v
-  | _ -> bad_type_error ()
+  | optv -> bad_type_error optv "int"
 
 let check_bool_value v = function
   | BoolValue _ -> BoolValue v
-  | _ -> bad_type_error ()
+  | optv -> bad_type_error optv "bool"
 
 let check_string_value v = function
   | StringValue _ -> StringValue v
   | StringOptValue _ -> StringOptValue (Some v)
-  | _ -> bad_type_error ()
+  | optv -> bad_type_error optv "string"
 
 let check_unset_value v = function
   | BoolValue _ -> BoolValue false
   | IntValue _ -> IntValue None
   | StringOptValue _ -> StringOptValue None
-  | _ -> bad_type_error ()
+  | optv -> bad_type_error optv "nothing"
 
 (* Nota: For compatibility reasons, some errors are treated as
    warning. This allows a script to refer to an option that doesn't
diff --git a/test-suite/output/BadOptionValueType.out b/test-suite/output/BadOptionValueType.out
new file mode 100644
index 0000000000..34d8518a75
--- /dev/null
+++ b/test-suite/output/BadOptionValueType.out
@@ -0,0 +1,8 @@
+The command has indeed failed with message:
+Bad type of value for this option: expected int, got string.
+The command has indeed failed with message:
+Bad type of value for this option: expected bool, got string.
+The command has indeed failed with message:
+Bad type of value for this option: expected bool, got int.
+The command has indeed failed with message:
+Bad type of value for this option: expected bool, got int.
diff --git a/test-suite/output/BadOptionValueType.v b/test-suite/output/BadOptionValueType.v
new file mode 100644
index 0000000000..b61c3757ba
--- /dev/null
+++ b/test-suite/output/BadOptionValueType.v
@@ -0,0 +1,4 @@
+Fail Set Default Timeout "2".
+Fail Set Debug Eauto "yes".
+Fail Set Debug Eauto 1.
+Fail Set Implicit Arguments 1.