Catch unknown base types.

diff --git a/libs/json/OMakefile b/libs/json/OMakefile
index a629b5c8addc629a9044be61c9154f26a42cc366..5e0462fdd302ef2a5fe5ff8063c19a2383596c46 100644 (file)
--- a/libs/json/OMakefile
+++ b/libs/json/OMakefile
@@ -19,6 +19,7 @@ section
 section
        GEN_FILES = parser.mli parser.ml lexer.ml
        OCamlGeneratedFiles($(GEN_FILES))
+       OCAML_OTHER_LIBS[] += unix
        CONV_FILES[] =
                lexer
                parser

diff --git a/libs/json/codegen.ml b/libs/json/codegen.ml
index 7301229abc781a4e20cc2b08e2f05d34b6ecc479..a2d542ff2a7042322bb5bf67ff4e7d65daec5be0 100644 (file)
--- a/libs/json/codegen.ml
+++ b/libs/json/codegen.ml
@@ -16,6 +16,13 @@
 open Syntax
 open Format
 
+exception Unknown_base_type of string
+
+let known_types = ((ref []) : string list ref)
+let is_known_type ident = List.mem ident !known_types
+let add_known_type ident = known_types := ident :: !known_types
+let reset_known_types () = known_types := []
+
 let base_to_str = function
        | B_string -> "string"  | B_int -> "int"        | B_int64 -> "int64"
        | B_bool -> "bool"      | B_ident s -> s
@@ -109,6 +116,9 @@ module To = struct
                let v = name_of_var inv in
                match typ with
                | C_base bt ->
+                       (match bt with
+                        | B_ident ident -> if not (is_known_type ident) then raise (Unknown_base_type ident)
+                        | _ -> ());
                        fprintf ff "%s_to_json %s" (base_to_str bt) v
                | C_option optt ->
                        let optv, venv = Var_env.new_ident_from_type venv optt in
@@ -205,6 +215,9 @@ module From = struct
                let v = name_of_var inv in
                match typ with
                | C_base bt ->
+                       (match bt with
+                        | B_ident ident -> if not (is_known_type ident) then raise (Unknown_base_type ident)
+                        | _ -> ());
                        fprintf ff "%s_of_json %s" (base_to_str bt) v
                | C_option optt ->
                        let optv, venv = Var_env.new_ident_from_type venv optt in
@@ -321,13 +334,23 @@ let generate_one_defn ff td =
        match td with
        | [] -> ()
        | h :: t ->
+               List.iter (fun (tname, _) -> add_known_type tname) td;
                generate_to_def ff First h;
                List.iter (generate_to_def ff Next) t;
                generate_from_def ff First h;
                List.iter (generate_from_def ff Next) t
 
 let generate defn_list ofn ifn =
-       let ff = formatter_of_out_channel (open_out ofn) in
-       generate_header ff ifn;
-       List.iter (generate_one_defn ff) defn_list;
-       fprintf ff "@?"
+       let oc = open_out ofn in
+       let ff = formatter_of_out_channel oc in
+       reset_known_types ();
+       try
+               generate_header ff ifn;
+               List.iter (generate_one_defn ff) defn_list;
+               fprintf ff "@?";
+               close_out oc
+       with
+       | Unknown_base_type id ->
+               Printf.eprintf "Error: Unknown base type \"%s\"\n" id;
+               close_out oc;
+               Unix.unlink ofn

diff --git a/libs/json/jsonc.ml b/libs/json/jsonc.ml
index e4d29fc24dcae2f1d2467f9438340db71a44e28e..4190048621ae7567e5a0ff21182384e4816c7548 100644 (file)
--- a/libs/json/jsonc.ml
+++ b/libs/json/jsonc.ml
@@ -27,7 +27,7 @@ let show_syntax_error e l =
                | Unmatched_comment -> Printf.sprintf "Unmatched comment"
                | Unterminated_comment -> Printf.sprintf "Unterminated comment"
        in
-       Printf.printf "%s: %s\n" loc msg;
+       Printf.eprintf "%s: %s\n" loc msg;
        exit 1
 
 let show_parse_error lexbuf =
@@ -36,8 +36,8 @@ let show_parse_error lexbuf =
                        lexbuf.lex_curr_p.pos_fname lexbuf.lex_curr_p.pos_lnum
                        (lexbuf.lex_curr_p.pos_cnum - lexbuf.lex_curr_p.pos_bol) in
        (match lxm with
-       | "" -> Printf.printf "%s: parsing error\n" loc
-       | _  -> Printf.printf "%s: parsing error at \"%s\"\n" loc lxm);
+       | "" -> Printf.eprintf "%s: parsing error\n" loc
+       | _  -> Printf.eprintf "%s: parsing error at \"%s\"\n" loc lxm);
        exit 1
 
 let parse_file file =