[AL] New exception ALFileException with source-location info

Reviewed By: dulmarod

Differential Revision: D5639534

fbshipit-source-id: ea18394

infer/src/clang/CTLExceptions.ml

@@ -7,4 +7,23 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 
-exception ALParsingException of string
+exception ALParserInvariantViolationException of string
+
+type exc_info = {description: string; filename: string; line: int}
+
+exception ALFileException of exc_info
+
+let hum_string_of_exc_info exc_info =
+  Format.sprintf "%s at %s:%d" exc_info.description exc_info.filename exc_info.line
+
+let create_exc_info description lexbuf =
+  let pos = lexbuf.Lexing.lex_curr_p in
+  {description; filename= pos.pos_fname; line= pos.pos_lnum}
+
+let () =
+  Caml.Printexc.register_printer (fun exc ->
+      match exc with
+      | ALFileException exc_info
+       -> Some (Format.sprintf "ALFileException: %s" (hum_string_of_exc_info exc_info))
+      | _
+       -> None )

infer/src/clang/CTLExceptions.mli

@@ -7,4 +7,17 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 
-exception ALParsingException of string
+exception
+  ALParserInvariantViolationException of
+  string(** Raised when the parser encounters a violation of a certain invariant  *)
+
+type exc_info
+
+exception
+  ALFileException of
+  exc_info(** Raised when any exception from the lexer/parser of AL is caught, to include source-location info *)
+
+val create_exc_info : string -> Lexing.lexbuf -> exc_info
+
+val hum_string_of_exc_info : exc_info -> string
+(** human-readable version of exc_info *)

infer/src/clang/cFrontend_checkers_main.ml

@@ -13,17 +13,12 @@ open Ctl_lexer
 module L = Logging
 
 let parse_al_file fname channel : CTL.al_file option =
-  let pos_str lexbuf =
-    let pos = lexbuf.lex_curr_p in
-    pos.pos_fname ^ ":" ^ string_of_int pos.pos_lnum ^ ":"
-    ^ string_of_int (pos.pos_cnum - pos.pos_bol + 1)
-  in
   let parse_with_error lexbuf =
     try Some (Ctl_parser.al_file token lexbuf) with
-    | CTLExceptions.ALParsingException s
-     -> raise (CTLExceptions.ALParsingException (s ^ " at " ^ pos_str lexbuf))
+    | CTLExceptions.ALParserInvariantViolationException s
+     -> raise CTLExceptions.(ALFileException (create_exc_info s lexbuf))
     | SyntaxError _ | Ctl_parser.Error
-     -> raise (CTLExceptions.ALParsingException ("SYNTAX ERROR at " ^ pos_str lexbuf))
+     -> raise CTLExceptions.(ALFileException (create_exc_info "SYNTAX ERROR" lexbuf))
   in
   let lexbuf = Lexing.from_channel channel in
   lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname= fname} ;

infer/src/clang/cPredicates.ml

@@ -8,7 +8,6 @@
  *)
 
 open! IStd
-open Lexing
 open Types_lexer
 module L = Logging
 
@@ -542,19 +541,16 @@ let class_unavailable_in_supported_ios_sdk (cxt: CLintersContext.context) an =
 
 (* Check whether a type_ptr and a string denote the same type *)
 let type_ptr_equal_type type_ptr type_str =
-  let pos_str lexbuf =
-    let pos = lexbuf.lex_curr_p in
-    pos.pos_fname ^ ":" ^ string_of_int pos.pos_lnum ^ ":"
-    ^ string_of_int (pos.pos_cnum - pos.pos_bol + 1)
-  in
   let parse_type_string str =
     L.(debug Linters Medium) "Starting parsing type string '%s'@\n" str ;
     let lexbuf = Lexing.from_string str in
     try Types_parser.abs_ctype token lexbuf with
-    | CTLExceptions.ALParsingException s
-     -> raise (CTLExceptions.ALParsingException ("Syntax Error when defining type" ^ s))
+    | CTLExceptions.ALParserInvariantViolationException s
+     -> raise
+          (CTLExceptions.(
+            ALFileException (create_exc_info ("Syntax Error when defining type " ^ s) lexbuf)))
     | SyntaxError _ | Types_parser.Error
-     -> raise (CTLExceptions.ALParsingException ("SYNTAX ERROR at " ^ pos_str lexbuf))
+     -> raise CTLExceptions.(ALFileException (create_exc_info "SYNTAX ERROR" lexbuf))
   in
   let abs_ctype =
     match String.Map.find !parsed_type_map type_str with

infer/src/clang/ctl_parser.mly

@@ -16,7 +16,7 @@
 
   let is_not_infer_reserved_id id =
     if Str.string_match (Str.regexp_string Ctl_parser_types.infer_prefix) id 0 then
-      raise (CTLExceptions.ALParsingException
+      raise (CTLExceptions.ALParserInvariantViolationException
                ("ERROR: " ^ id ^ " contains __infer_ctl_ that is a reserved keyword "
             ^ "which cannot be used in identifiers:"))
      else ()
@@ -25,7 +25,7 @@
        if (List.mem ~equal:ALVar.equal !formal_params (ALVar.Var id)) then
          L.(debug Linters Verbose) "\tParsed exp '%s' as variable" id
        else
-         raise (CTLExceptions.ALParsingException
+         raise (CTLExceptions.ALParserInvariantViolationException
                   ("ERROR: Variable '" ^ id ^ "' is undefined"))
 
 %}

infer/src/clang/types_parser.mly

@@ -28,7 +28,7 @@
     | [UInt; Long; Long] -> BuiltIn ULongLong
     | [Long; Double] -> BuiltIn LongDouble
     | [UInt; Int128] -> BuiltIn UInt128
-    | _ -> raise (CTLExceptions.ALParsingException
+    | _ -> raise (CTLExceptions.ALParserInvariantViolationException
       ("ERROR: syntax error on types"))