Merge pull request #1737 from rgrinberg/improve-errors-configurator

Add proper parsing errors when failing to extract values

src/configurator/v1.ml

@@ -322,13 +322,21 @@ module C_define = struct
       | Switch
       | Int
       | String
+
+    let name = function
+      | Switch -> "bool"
+      | Int -> "int"
+      | String -> "string"
   end
 
   module Value = struct
     type t =
       | Switch of bool
       | Int    of int
       | String of string
+
+    let switch b = Switch b
+    let int i = Int i
   end
 
   let extract_program ?prelude includes vars =
@@ -351,7 +359,7 @@ module C_define = struct
 #define DUNE_D7(x) ('0'+(DUNE_ABS(x)/10000000  )%%10), DUNE_D6(x)
 #define DUNE_D8(x) ('0'+(DUNE_ABS(x)/100000000 )%%10), DUNE_D7(x)
 #define DUNE_D9(x) ('0'+(DUNE_ABS(x)/1000000000)%%10), DUNE_D8(x)
-#define DUNE_SIGN(x) ((x >= 0)? '+': '-')
+#define DUNE_SIGN(x) ((x >= 0)? '0': '-')
 |}
     );
     List.iteri vars ~f:(fun i (name, t) ->
@@ -392,15 +400,32 @@ const char *s%i = "BEGIN-%i-false-END";
       |> Int.Map.of_list_exn
     in
     List.mapi vars ~f:(fun i (name, t) ->
+      let raw_val =
+        match Int.Map.find values i with
+        | None -> die "Unable to get value for %s" name
+        | Some v -> v
+      in
       let value =
-        let raw_val =
-          match Int.Map.find values i with
-          | None -> die "Unable to get value for %s" name
-          | Some v -> v in
         match t with
-        | Type.Switch -> Value.Switch (bool_of_string raw_val)
-        | Int -> Int (int_of_string raw_val)
-        | String -> String raw_val in
+        | Type.Switch ->
+          Bool.of_string raw_val
+          |> Option.map ~f:Value.switch
+        | Int ->
+          Int.of_string raw_val
+          |> Option.map ~f:Value.int
+        | String -> Some (String raw_val)
+      in
+      let value =
+        match value with
+        | Some v -> v
+        | None ->
+          let msg =
+            sprintf "Unable to read variable %S of type %s. \
+                     Invalid value %S in %s found"
+              name (Type.name t) raw_val obj_file
+          in
+          raise (Fatal_error msg)
+      in
       (name, value))
 
   let import t ?prelude ?c_flags ~includes vars =
@@ -545,4 +570,5 @@ let main ?(args=[]) ~name f =
     | Fatal_error msg ->
       eprintf "Error: %s\n%!" msg;
       exit 1
-    | _ -> Exn.raise_with_backtrace exn bt
+    | _ ->
+      Exn.raise_with_backtrace exn bt

src/stdune/bool.ml

@@ -8,3 +8,5 @@ let compare x y =
   | false, true -> Lt
 
 let to_string = string_of_bool
+
+let of_string s = Option.try_with (fun () -> bool_of_string s)

src/stdune/bool.mli

@@ -3,3 +3,5 @@ type t = bool
 val compare : t -> t -> Ordering.t
 
 val to_string : t -> string
+
+val of_string : string -> t option

src/stdune/int.ml

@@ -28,3 +28,5 @@ let of_string_exn s =
 let to_string i = string_of_int i
 
 module Infix = Comparable.Operators(T)
+
+let of_string s = Option.try_with (fun () -> int_of_string s)

src/stdune/int.mli

@@ -8,6 +8,7 @@ module Set : Set.S with type elt = t
 module Map : Map.S with type key = t
 
 val of_string_exn : string -> t
+val of_string : string -> t option
 
 val to_string : t -> string
 

src/stdune/option.ml

@@ -71,3 +71,8 @@ let compare cmp x y =
   | Some _, None -> Gt
   | None, Some _ -> Lt
   | Some x, Some y -> cmp x y
+
+let try_with f =
+  match f () with
+  | exception _ -> None
+  | s -> Some s

src/stdune/option.mli

@@ -32,3 +32,5 @@ val to_list : 'a t -> 'a list
 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 
 val compare : ('a -> 'a -> Ordering.t) -> 'a t -> 'a t -> Ordering.t
+
+val try_with : (unit -> 'a) -> 'a option