Revu les erreurs de syntaxe sur les parentheses pas fermees, etc

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1760 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Author: xavierleroy

boot/ocamllex

@@ -60,10 +60,10 @@ let setup_terminal_info() =
 
 let num_loc_lines = ref 0 (* number of lines already printed after input *)
 
-let rec highlight_location loc =
+let rec highlight_locations loc1 loc2 =
   match !status with
     Unknown ->
-      setup_terminal_info(); highlight_location loc
+      setup_terminal_info(); highlight_locations loc1 loc2
   | Bad_term ->
       false
   | Good_term ->
@@ -90,9 +90,9 @@ let rec highlight_location loc =
 	      print_string "# ";
               for pos = 0 to String.length lb.lex_buffer - pos0 - 1 do
                 if !bol then (print_string "  "; bol := false);
-                if pos = loc.loc_start then
+                if pos = loc1.loc_start || pos = loc2.loc_start then
                   Terminfo.puts stdout !start_standout 1;
-                if pos = loc.loc_end then
+                if pos = loc1.loc_end || pos = loc2.loc_end then
                   Terminfo.puts stdout !end_standout 1;
                 let c = lb.lex_buffer.[pos + pos0] in
                 print_char c;
@@ -122,7 +122,7 @@ let (msg_file, msg_line, msg_chars, msg_to, msg_colon, warn_head) =
 
 let print loc =
   if String.length !input_name = 0 then
-    if highlight_location loc then () else begin
+    if highlight_locations loc none then () else begin
       print_string "Characters ";
       print_int loc.loc_start; print_string "-";
       print_int loc.loc_end; print_string ":";

parsing/location.ml

@@ -27,3 +27,5 @@ val print: t -> unit
 val print_warning: t -> string -> unit
 val echo_eof: unit -> unit
 val reset: unit -> unit
+
+val highlight_locations: t -> t -> bool

parsing/location.mli

@@ -47,7 +47,7 @@ let wrap parsing_fun lexbuf =
     | Syntaxerr.Error _ as err ->
         if !Location.input_name = "" then maybe_skip_phrase lexbuf;
         raise err
-    | Parsing.Parse_error ->
+    | Parsing.Parse_error | Syntaxerr.Escape_error ->
         let loc = { loc_start = Lexing.lexeme_start lexbuf;
                     loc_end = Lexing.lexeme_end lexbuf } in
         if !Location.input_name = "" 

parsing/parse.ml

@@ -105,6 +105,9 @@ let rec mkrangepat c1 c2 =
   mkpat(Ppat_or(mkpat(Ppat_constant(Const_char c1)),
                 mkrangepat (Char.chr(Char.code c1 + 1)) c2))
 
+let syntax_error () =
+  raise Syntaxerr.Escape_error
+
 let unclosed opening_name opening_num closing_name closing_num =
   raise(Syntaxerr.Error(Syntaxerr.Unclosed(rhs_loc opening_num, opening_name,
                                            rhs_loc closing_num, closing_name)))
@@ -419,6 +422,8 @@ expr:
       { mkexp(Pexp_apply($1, List.rev $2)) }
   | LET rec_flag let_bindings IN seq_expr %prec prec_let
       { mkexp(Pexp_let($2, List.rev $3, $5)) }
+  | LET rec_flag let_bindings IN error %prec prec_let
+      { syntax_error() }
   | LET rec_flag let_bindings error %prec prec_let
       { unclosed "let" 1 "in" 4 }
   | PARSER opt_pat opt_bar parser_cases %prec prec_fun
@@ -433,6 +438,8 @@ expr:
       { mkexp(Pexp_apply(Pstream.cparser ($5, List.rev $7), [$2])) }
   | TRY seq_expr WITH opt_bar match_cases %prec prec_try
       { mkexp(Pexp_try($2, List.rev $5)) }
+  | TRY seq_expr WITH error %prec prec_try
+      { syntax_error() }
   | TRY seq_expr error %prec prec_try
       { unclosed "try" 1 "with" 3 }
   | expr_comma_list
@@ -517,8 +524,6 @@ simple_expr:
       { unclosed "begin" 1 "end" 3 }
   | LPAREN seq_expr type_constraint RPAREN
       { let (t, t') = $3 in mkexp(Pexp_constraint($2, t, t')) }
-  | LPAREN seq_expr type_constraint error
-      { unclosed "(" 1 ")" 4 }
   | simple_expr DOT label_longident
       { mkexp(Pexp_field($1, $3)) }
   | simple_expr DOT LPAREN seq_expr RPAREN
@@ -670,6 +675,8 @@ type_constraint:
     COLON core_type                             { (Some $2, None) }
   | COLON core_type COLONGREATER core_type      { (Some $2, Some $4) }
   | COLONGREATER core_type                      { (None, Some $2) }
+  | COLON error                                 { syntax_error() }
+  | COLONGREATER error                          { syntax_error() }
 ;
 
 /* Patterns */

parsing/parser.mly

@@ -20,25 +20,27 @@ type error =
   | Other of Location.t
 
 exception Error of error
+exception Escape_error
 
 let report_error = function
     Unclosed(opening_loc, opening, closing_loc, closing) ->
-      if String.length !Location.input_name > 0 then begin
-        Location.print closing_loc;
-        print_string "Syntax error: missing '";
+      if String.length !Location.input_name = 0
+      && Location.highlight_locations opening_loc closing_loc
+      then begin
+        print_string "Syntax error: '";
         print_string closing;
-        print_string "'"; force_newline();
-        Location.print opening_loc;
-        print_string "This is the location of the unmatched '";
+        print_string "' expected, the highlighted '";
         print_string opening;
-        print_string "'"
+        print_string "' might be unmatched"
       end else begin
+        Location.print closing_loc;
+        print_string "Syntax error: '";
+        print_string closing;
+        print_string "' expected"; force_newline();
         Location.print opening_loc;
-        print_string "Syntax error: this '";
+        print_string "This '";
         print_string opening;
-        print_string "' has no matching '";
-        print_string closing;
-        print_string "'"
+        print_string "' might be unmatched"
       end
   | Other loc ->
       Location.print loc;

parsing/syntaxerr.ml

@@ -18,5 +18,6 @@ type error =
   | Other of Location.t
 
 exception Error of error
+exception Escape_error
 
 val report_error: error -> unit