[json] Generate errors for trailing comma in array, and for unterminated values.

diff --git a/libs/json/json_parse.ml b/libs/json/json_parse.ml
index d4fa2f976bd6b3c3498f31bfa3c3b6cf28395a01..e36ca4eb2db5014a2cbd7214a6687a4b26b9730b 100644 (file)
--- a/libs/json/json_parse.ml
+++ b/libs/json/json_parse.ml
@@ -15,6 +15,7 @@
 
 type cursor =
        | Start
+       | Expect_value
        | In_null of int
        | In_true of int
        | In_false of int
@@ -29,7 +30,6 @@ type cursor =
        | Expect_object_elem_colon
        | Expect_comma_or_end
        | Expect_object_key
-       | Error
        | Done of Json.t
 
 type int_value =
@@ -69,6 +69,16 @@ let ivalue_to_str = function
        | IObject_needs_value _ -> "object_needing_value"
        | IArray _ -> "array"
 
+let current_cursor_value = function
+       | Start | Expect_value -> "value"
+       | In_null _ -> "null"
+       | In_true _ | In_false _ -> "boolean"
+       | In_int _ | In_float _ | In_int_exp _ | In_float_exp _  -> "number"
+       | In_string _ | In_string_control _ | In_string_hex _ -> "string"
+       | Expect_object_elem_start | Expect_object_elem_colon | Expect_object_key -> "object"
+       | Expect_comma_or_end -> "object/array"
+       | Done _ -> ""
+
 let is_space c = c = ' ' || c = '\t' || c = '\n' || c = '\r'
 
 let is_hex_char = function
@@ -94,6 +104,7 @@ let clist_to_string cs =
 
 exception Unexpected_char of char * (* json type *) string
 exception Invalid_value of (* value *) string * (* json type *) string
+exception Unterminated_value of string
 exception Internal_error of string
 
 let finish_value s v =
@@ -128,6 +139,7 @@ let pop_stack s =
                raise (Internal_error "empty stack at pop_stack")
 
 let rec parse_char s c =
+       (* Printf.printf "parsing %C at %s...\n" c (current_cursor_value s.cursor); *)
        let finish_int is =
                let str = clist_to_string (List.rev is) in
                let int = try Int64.of_string str
@@ -182,6 +194,27 @@ let rec parse_char s c =
                        ()
                 | _ ->
                        raise (Unexpected_char (c, "start")))
+       | Expect_value ->
+               (match c with
+                | 'n' ->
+                       s.cursor <- In_null 3
+                | 't' ->
+                       s.cursor <- In_true 3
+                | 'f' ->
+                       s.cursor <- In_false 4
+                | '-' | '0' .. '9' ->
+                       s.cursor <- In_int [c]
+                | '"' ->
+                       s.cursor <- In_string []
+                | '{' ->
+                       s.cursor <- Expect_object_elem_start
+                | '[' ->
+                       s.stack  <- (IArray []) :: s.stack;
+                       s.cursor <- Start
+                | _ when is_space c ->
+                       ()
+                | _ ->
+                       raise (Unexpected_char (c, "value")))
        | In_null rem ->
                (match c, rem with
                 | 'u', 3 ->
@@ -323,7 +356,7 @@ let rec parse_char s c =
                (match c with
                 | ',' ->
                        if is_parsing_object s then s.cursor <- Expect_object_key
-                       else s.cursor <- Start
+                       else s.cursor <- Expect_value
                 | '}' ->
                        if is_parsing_object s then pop_stack s
                        else raise (Unexpected_char (c, "comma_or_end"))
@@ -346,8 +379,6 @@ let rec parse_char s c =
                        ()
                 | _ ->
                        raise (Unexpected_char (c, "object_key")))
-       | Error ->
-               ()
        | Done _ ->
                raise (Internal_error "parse called when parse_state is 'Done'")
 
@@ -361,13 +392,13 @@ let call_parser state str =
        let i = ref 0 in
        while get_parse_result state = None && !i < len do
                parse_char state str.[!i];
-               (* This is here instead of inside parse_char since
+               (* This is here instead of inside parse_char since
                   parse_char makes (tail-)recursive calls without
                   consuming a character.
                *)
-               state.num_chars_parsed <- state.num_chars_parsed + 1;
+               state.num_chars_parsed <- state.num_chars_parsed + 1;
 
-               incr i
+               incr i
        done;
        match get_parse_result state with
        | Some v -> Json_value (v, (String.sub str !i (len - !i)))
@@ -386,6 +417,8 @@ let parse state str =
 let finish_parse state =
        match parse state " " with
        | Json_value (v, _) -> Some v
-       | Json_parse_incomplete _ -> None
+       | Json_parse_incomplete _ ->
+               if state.cursor = Start then None
+               else raise (Unterminated_value (current_cursor_value state.cursor))
 
 let num_chars_parsed state = state.num_chars_parsed

diff --git a/libs/json/json_parse.mli b/libs/json/json_parse.mli
index 89af20bebceaf5e0e0e599c30da004dd1f1982bc..e881d8c5cc583f91839672cc73bdea8b8e36d253 100644 (file)
--- a/libs/json/json_parse.mli
+++ b/libs/json/json_parse.mli
@@ -29,4 +29,5 @@ val num_chars_parsed: parse_state -> int
 
 exception Unexpected_char of char * (* json type *) string
 exception Invalid_value of (* value *) string * (* json type *) string
+exception Unterminated_value of string
 exception Internal_error of string