PR#5238, PR#5277: Sys_error when getting error location

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

6 files changed, 13 insertions, 122 deletions

diff --git a/parsing/linenum.mli b/parsing/linenum.mli
deleted file mode 100644
index e63694761..000000000
--- a/parsing/linenum.mli
+++ /dev/null
@@ -1,23 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* An auxiliary lexer for determining the line number corresponding to
-   a file position, honoring the directives # linenum "filename" *)
-
-val for_position: string -> int -> string * int * int
-        (* [Linenum.for_position file loc] returns a triple describing
-           the location [loc] in the file named [file].
-           First result is name of actual source file.
-           Second result is line number in that source file.
-           Third result is position of beginning of that line in [file]. *)
diff --git a/parsing/linenum.mll b/parsing/linenum.mll
deleted file mode 100644
index 1844d361f..000000000
--- a/parsing/linenum.mll
+++ /dev/null
@@ -1,74 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* An auxiliary lexer for determining the line number corresponding to
-   a file position, honoring the directives # linenum "filename" *)
-
-{
-let filename = ref ""
-let linenum = ref 0
-let linebeg = ref 0
-
-let parse_sharp_line s =
-  try
-    (* Update the line number and file name *)
-    let l1 = ref 0 in
-    while let c = s.[!l1] in c < '0' || c > '9' do incr l1 done;
-    let l2 = ref (!l1 + 1) in
-    while let c = s.[!l2] in c >= '0' && c <= '9' do incr l2 done;
-    linenum := int_of_string(String.sub s !l1 (!l2 - !l1));
-    let f1 = ref (!l2 + 1) in
-    while !f1 < String.length s && s.[!f1] <> '"' do incr f1 done;
-    let f2 = ref (!f1 + 1) in
-    while !f2 < String.length s && s.[!f2] <> '"' do incr f2 done;
-    if !f1 < String.length s then
-      filename := String.sub s (!f1 + 1) (!f2 - !f1 - 1)
-  with Failure _ | Invalid_argument _ ->
-    Misc.fatal_error "Linenum.parse_sharp_line"
-}
-
-rule skip_line = parse
-    "#" [' ' '\t']* ['0'-'9']+ [' ' '\t']*
-    ("\"" [^ '\n' '\r' '"' (* '"' *) ] * "\"")?
-    [^ '\n' '\r'] *
-    ('\n' | '\r' | "\r\n")
-      { parse_sharp_line(Lexing.lexeme lexbuf);
-        linebeg := Lexing.lexeme_start lexbuf;
-        Lexing.lexeme_end lexbuf }
-  | [^ '\n' '\r'] *
-    ('\n' | '\r' | "\r\n")
-      { incr linenum;
-        linebeg := Lexing.lexeme_start lexbuf;
-        Lexing.lexeme_end lexbuf }
-  | [^ '\n' '\r'] * eof
-      { incr linenum;
-        linebeg := Lexing.lexeme_start lexbuf;
-        raise End_of_file }
-
-{
-
-let for_position file loc =
-  let ic = open_in_bin file in
-  let lb = Lexing.from_channel ic in
-  filename := file;
-  linenum := 1;
-  linebeg := 0;
-  begin try
-    while skip_line lb <= loc do () done
-  with End_of_file -> ()
-  end;
-  close_in ic;
-  (!filename, !linenum - 1, !linebeg)
-
-}
diff --git a/parsing/location.ml b/parsing/location.ml
index e9a988245..e4c09aa3a 100644
--- a/parsing/location.ml
+++ b/parsing/location.ml
@@ -16,8 +16,6 @@ open Lexing
 
 type t = { loc_start: position; loc_end: position; loc_ghost: bool };;
 
-let none = { loc_start = dummy_pos; loc_end = dummy_pos; loc_ghost = true };;
-
 let in_file name =
   let loc = {
     pos_fname = name;
@@ -28,6 +26,8 @@ let in_file name =
   { loc_start = loc; loc_end = loc; loc_ghost = true }
 ;;
 
+let none = in_file "_none_";;
+
 let curr lexbuf = {
   loc_start = lexbuf.lex_start_p;
   loc_end = lexbuf.lex_curr_p;
@@ -204,31 +204,21 @@ let (msg_file, msg_line, msg_chars, msg_to, msg_colon, msg_head) =
 
 (* return file, line, char from the given position *)
 let get_pos_info pos =
-  let (filename, linenum, linebeg) =
-    if pos.pos_fname = "" && !input_name = "" then
-      ("", -1, 0)
-    else if pos.pos_fname = "" then
-      Linenum.for_position !input_name pos.pos_cnum
-    else
-      (pos.pos_fname, pos.pos_lnum, pos.pos_bol)
-  in
-  (filename, linenum, pos.pos_cnum - linebeg)
+  (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
 ;;
 
 let print ppf loc =
   let (file, line, startchar) = get_pos_info loc.loc_start in
   let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
-  let (startchar, endchar) =
-    if startchar < 0 then (0, 1) else (startchar, endchar)
-  in
-  if file = "" then begin
+  if file = "//toplevel//" then begin
     if highlight_locations ppf loc none then () else
       fprintf ppf "Characters %i-%i:@."
               loc.loc_start.pos_cnum loc.loc_end.pos_cnum
   end else begin
     fprintf ppf "%s%s%s%i" msg_file file msg_line line;
-    fprintf ppf "%s%i" msg_chars startchar;
-    fprintf ppf "%s%i%s@.%s" msg_to endchar msg_colon msg_head;
+    if startchar >= 0 then
+      fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar;
+    fprintf ppf "%s@.%s" msg_colon msg_head;
   end
 ;;
 
diff --git a/parsing/parse.ml b/parsing/parse.ml
index edeed48f2..cf862af3f 100644
--- a/parsing/parse.ml
+++ b/parsing/parse.ml
@@ -46,14 +46,14 @@ let wrap parsing_fun lexbuf =
   | Lexer.Error(Lexer.Unterminated_string, _) as err -> raise err
   | Lexer.Error(Lexer.Unterminated_string_in_comment, _) as err -> raise err
   | Lexer.Error(Lexer.Illegal_character _, _) as err ->
-      if !Location.input_name = "" then skip_phrase lexbuf;
+      if !Location.input_name = "//toplevel//" then skip_phrase lexbuf;
       raise err
   | Syntaxerr.Error _ as err ->
-      if !Location.input_name = "" then maybe_skip_phrase lexbuf;
+      if !Location.input_name = "//toplevel//" then maybe_skip_phrase lexbuf;
       raise err
   | Parsing.Parse_error | Syntaxerr.Escape_error ->
       let loc = Location.curr lexbuf in
-      if !Location.input_name = ""
+      if !Location.input_name = "//toplevel//"
       then maybe_skip_phrase lexbuf;
       raise(Syntaxerr.Error(Syntaxerr.Other loc))
 ;;
diff --git a/parsing/printast.ml b/parsing/printast.ml
index ef49e0308..713295f6f 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -19,9 +19,7 @@ open Location;;
 open Parsetree;;
 
 let fmt_position f l =
-  if l.pos_fname = "" && l.pos_lnum = 1
-  then fprintf f "%d" l.pos_cnum
-  else if l.pos_lnum = -1
+  if l.pos_lnum = -1
   then fprintf f "%s[%d]" l.pos_fname l.pos_cnum
   else fprintf f "%s[%d,%d+%d]" l.pos_fname l.pos_lnum l.pos_bol
                (l.pos_cnum - l.pos_bol)
diff --git a/parsing/syntaxerr.ml b/parsing/syntaxerr.ml
index 00e06bba0..b0fda3695 100644
--- a/parsing/syntaxerr.ml
+++ b/parsing/syntaxerr.ml
@@ -26,8 +26,8 @@ exception Escape_error
 
 let report_error ppf = function
   | Unclosed(opening_loc, opening, closing_loc, closing) ->
-      if String.length !Location.input_name = 0
-      && Location.highlight_locations ppf opening_loc closing_loc
+      if !Location.input_name = "//toplevel//"
+         && Location.highlight_locations ppf opening_loc closing_loc
       then fprintf ppf "Syntax error: '%s' expected, \
                    the highlighted '%s' might be unmatched" closing opening
       else begin