[AL] monomorphise CIssue.t

Summary:
That was an interesting way to do things. But let's not. Also the logic
to fill in the CIssue.t should probably do something to check that each
field was provided instead of just filling them with default values but
that's a separate concern.

Reviewed By: ngorogiannis

Differential Revision: D21664619

fbshipit-source-id: d49b74458
master
Jules Villard 5 years ago committed by Facebook GitHub Bot
parent b61f921572
commit 5572484eea

@ -12,7 +12,7 @@ module MF = MarkupFormatter
type linter = type linter =
{ condition: CTLTypes.t { condition: CTLTypes.t
; issue_desc: CIssue.issue_desc ; issue_desc: CIssue.t
; whitelist_paths: ALVar.t list ; whitelist_paths: ALVar.t list
; blacklist_paths: ALVar.t list } ; blacklist_paths: ALVar.t list }
@ -200,25 +200,31 @@ let string_to_issue_mode m =
L.die InternalError "Mode %s does not exist. Please specify ON/OFF" s L.die InternalError "Mode %s does not exist. Please specify ON/OFF" s
type parsed_issue_type = (** building a {!CIssue.t} piece by piece *)
{ name: string option type issue_in_construction =
{ issue_type_doc_url: string option
; issue_type_name: string option
(** issue name, if no name is given name will be a readable version of id, by removing (** issue name, if no name is given name will be a readable version of id, by removing
underscores and capitalizing first letters of words *) underscores and capitalizing first letters of words *)
; doc_url: string option } ; description: string
; mode: CIssue.mode
; loc: Location.t
; severity: Exceptions.severity
; suggestion: string option }
(** Convert a parsed checker in list of linters *) (** Convert a parsed checker in list of linters *)
let create_parsed_linters linters_def_file checkers : linter list = let create_parsed_linters linters_def_file checkers : linter list =
let open CIssue in
let open CTL in let open CTL in
L.(debug Linters Medium) "@\nConverting checkers in (condition, issue) pairs@\n" ; L.(debug Linters Medium) "@\nConverting checkers in (condition, issue) pairs@\n" ;
let do_one_checker checker : linter = let do_one_checker checker : linter =
let dummy_issue = let dummy_issue : issue_in_construction =
{ issue_type= {name= None; doc_url= None} { issue_type_doc_url= None
; issue_type_name= None
; description= "" ; description= ""
; suggestion= None ; suggestion= None
; loc= Location.dummy ; loc= Location.dummy
; severity= Exceptions.Warning ; severity= Warning
; mode= CIssue.On } ; mode= On }
in in
let issue_desc, condition, whitelist_paths, blacklist_paths = let issue_desc, condition, whitelist_paths, blacklist_paths =
let process_linter_definitions (issue, cond, wl_paths, bl_paths) description = let process_linter_definitions (issue, cond, wl_paths, bl_paths) description =
@ -234,15 +240,9 @@ let create_parsed_linters linters_def_file checkers : linter list =
| CDesc (av, m) when ALVar.is_mode_keyword av -> | CDesc (av, m) when ALVar.is_mode_keyword av ->
({issue with mode= string_to_issue_mode m}, cond, wl_paths, bl_paths) ({issue with mode= string_to_issue_mode m}, cond, wl_paths, bl_paths)
| CDesc (av, doc) when ALVar.is_doc_url_keyword av -> | CDesc (av, doc) when ALVar.is_doc_url_keyword av ->
( {issue with issue_type= {issue.issue_type with doc_url= Some doc}} ({issue with issue_type_doc_url= Some doc}, cond, wl_paths, bl_paths)
, cond
, wl_paths
, bl_paths )
| CDesc (av, name) when ALVar.is_name_keyword av -> | CDesc (av, name) when ALVar.is_name_keyword av ->
( {issue with issue_type= {issue.issue_type with name= Some name}} ({issue with issue_type_name= Some name}, cond, wl_paths, bl_paths)
, cond
, wl_paths
, bl_paths )
| CPath (`WhitelistPath, paths) -> | CPath (`WhitelistPath, paths) ->
(issue, cond, paths, bl_paths) (issue, cond, paths, bl_paths)
| CPath (`BlacklistPath, paths) -> | CPath (`BlacklistPath, paths) ->
@ -260,13 +260,20 @@ let create_parsed_linters linters_def_file checkers : linter list =
let doc_url = let doc_url =
Option.first_some Option.first_some
(Config.get_linter_doc_url ~linter_id:checker.id) (Config.get_linter_doc_url ~linter_id:checker.id)
issue_desc.issue_type.doc_url issue_desc.issue_type_doc_url
in in
IssueType.register_from_string ~id:checker.id ?hum:issue_desc.issue_type.name ?doc_url IssueType.register_from_string ~id:checker.id ?hum:issue_desc.issue_type_name ?doc_url
~linters_def_file Linters ~linters_def_file Linters
in in
let issue_desc = {issue_desc with issue_type} in let issue_desc =
L.(debug Linters Medium) "@\nIssue_desc = %a@\n" CIssue.pp_issue issue_desc ; { CIssue.issue_type
; description= issue_desc.description
; mode= issue_desc.mode
; loc= issue_desc.loc
; severity= issue_desc.severity
; suggestion= issue_desc.suggestion }
in
L.debug Linters Medium "@\nIssue_desc = %a@\n" CIssue.pp issue_desc ;
{condition; issue_desc; whitelist_paths; blacklist_paths} {condition; issue_desc; whitelist_paths; blacklist_paths}
in in
List.map ~f:do_one_checker checkers List.map ~f:do_one_checker checkers
@ -473,8 +480,7 @@ let expand_checkers macro_map path_map checkers =
let issue_log = ref IssueLog.empty let issue_log = ref IssueLog.empty
(** Add a frontend warning with a description desc at location loc to the errlog of a proc desc *) (** Add a frontend warning with a description desc at location loc to the errlog of a proc desc *)
let log_frontend_issue method_decl_opt (node : Ctl_parser_types.ast_node) let log_frontend_issue method_decl_opt (node : Ctl_parser_types.ast_node) (issue_desc : CIssue.t) =
(issue_desc : CIssue.issue_desc) =
let procname = let procname =
match method_decl_opt with match method_decl_opt with
| Some method_decl -> | Some method_decl ->
@ -501,8 +507,7 @@ let log_frontend_issue method_decl_opt (node : Ctl_parser_types.ast_node)
~node_key ~node_key
let fill_issue_desc_info_and_log context ~witness ~current_node (issue_desc : CIssue.issue_desc) loc let fill_issue_desc_info_and_log context ~witness ~current_node (issue_desc : CIssue.t) loc =
=
let process_message message = let process_message message =
remove_new_lines_and_whitespace (expand_message_string context message current_node) remove_new_lines_and_whitespace (expand_message_string context message current_node)
in in

@ -11,7 +11,7 @@ val issue_log : IssueLog.t ref
type linter = type linter =
{ condition: CTLTypes.t { condition: CTLTypes.t
; issue_desc: CIssue.issue_desc ; issue_desc: CIssue.t
; whitelist_paths: ALVar.t list ; whitelist_paths: ALVar.t list
; blacklist_paths: ALVar.t list } ; blacklist_paths: ALVar.t list }

@ -14,22 +14,22 @@ val contains_ck_impl : Clang_ast_t.decl list -> bool
Does not recurse into hierarchy. *) Does not recurse into hierarchy. *)
val mutable_local_vars_advice : val mutable_local_vars_advice :
CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.issue_desc option CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.t option
val component_factory_function_advice : val component_factory_function_advice :
CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.issue_desc option CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.t option
val component_with_unconventional_superclass_advice : val component_with_unconventional_superclass_advice :
CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.issue_desc option CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.t option
val component_with_multiple_factory_methods_advice : val component_with_multiple_factory_methods_advice :
CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.issue_desc list CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.t list
val component_initializer_with_side_effects_advice : val component_initializer_with_side_effects_advice :
CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.issue_desc option CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.t option
val component_file_line_count_info : val component_file_line_count_info :
CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.issue_desc list CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.t list
val component_file_cyclomatic_complexity_info : val component_file_cyclomatic_complexity_info :
CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.issue_desc option CLintersContext.context -> Ctl_parser_types.ast_node -> CIssue.t option

@ -9,19 +9,25 @@ open! IStd
type mode = On | Off type mode = On | Off
type 'issue_type issue_desc0 = let string_of_mode m = match m with On -> "On" | Off -> "Off"
{ issue_type: 'issue_type (** issue type *)
let should_run_check mode =
match mode with
| On ->
true
| Off ->
Config.debug_mode || Config.debug_exceptions || not Config.filtering
type t =
{ issue_type: IssueType.t
; description: string (** Description in the error message *) ; description: string (** Description in the error message *)
; mode: mode ; mode: mode
; loc: Location.t (** location in the code *) ; loc: Location.t (** location in the code *)
; severity: Exceptions.severity ; severity: Exceptions.severity
; suggestion: string option (** an optional suggestion or correction *) } ; suggestion: string option (** an optional suggestion or correction *) }
type issue_desc = IssueType.t issue_desc0 let pp fmt issue =
let string_of_mode m = match m with On -> "On" | Off -> "Off"
let pp_issue fmt issue =
Format.fprintf fmt "{@\n Id = %s@\n" issue.issue_type.IssueType.unique_id ; Format.fprintf fmt "{@\n Id = %s@\n" issue.issue_type.IssueType.unique_id ;
Format.fprintf fmt "{ Name = %s@\n" issue.issue_type.IssueType.hum ; Format.fprintf fmt "{ Name = %s@\n" issue.issue_type.IssueType.hum ;
Format.fprintf fmt " Severity = %s@\n" (Exceptions.severity_string issue.severity) ; Format.fprintf fmt " Severity = %s@\n" (Exceptions.severity_string issue.severity) ;
@ -32,11 +38,3 @@ let pp_issue fmt issue =
(Option.value ~default:"" issue.issue_type.IssueType.doc_url) ; (Option.value ~default:"" issue.issue_type.IssueType.doc_url) ;
Format.fprintf fmt " Loc = %s@\n" (Location.to_string issue.loc) ; Format.fprintf fmt " Loc = %s@\n" (Location.to_string issue.loc) ;
Format.fprintf fmt "}@\n" Format.fprintf fmt "}@\n"
let should_run_check mode =
match mode with
| On ->
true
| Off ->
Config.debug_mode || Config.debug_exceptions || not Config.filtering

@ -9,16 +9,14 @@ open! IStd
type mode = On | Off type mode = On | Off
type 'issue_type issue_desc0 = val should_run_check : mode -> bool
{ issue_type: 'issue_type (** issue type *)
type t =
{ issue_type: IssueType.t
; description: string (** Description in the error message *) ; description: string (** Description in the error message *)
; mode: mode ; mode: mode
; loc: Location.t (** location in the code *) ; loc: Location.t (** location in the code *)
; severity: Exceptions.severity ; severity: Exceptions.severity
; suggestion: string option (** an optional suggestion or correction *) } ; suggestion: string option (** an optional suggestion or correction *) }
type issue_desc = IssueType.t issue_desc0 val pp : Format.formatter -> t -> unit
val pp_issue : Format.formatter -> issue_desc -> unit
val should_run_check : mode -> bool

Loading…
Cancel
Save