[clang] minorish improvements

Summary:
- delete getter for `CContext.context.procdesc`
- change API of `CLocation`, in particular to take just a source file instead of a `CContext` since that's all they need (but maybe we'd rather type less?)
- thread `source_range` of source statement to where useful for logging (could do more in the future)

Reviewed By: da319

Differential Revision: D7950573

fbshipit-source-id: 2755f7d
master
Jules Villard 7 years ago committed by Facebook Github Bot
parent 85b8087f66
commit 316da14857

@ -13,8 +13,10 @@ let log_caught_exception (trans_unit_ctx: CFrontend_config.translation_unit_cont
let caught_exception = let caught_exception =
EventLogger.FrontendException EventLogger.FrontendException
{ exception_type { exception_type
; source_location_start= CLocation.clang_to_sil_location trans_unit_ctx source_location_start ; source_location_start=
; source_location_end= CLocation.clang_to_sil_location trans_unit_ctx source_location_end CLocation.clang_to_sil_location trans_unit_ctx.source_file source_location_start
; source_location_end=
CLocation.clang_to_sil_location trans_unit_ctx.source_file source_location_end
; exception_triggered_location ; exception_triggered_location
; ast_node ; ast_node
; lang= CFrontend_config.string_of_clang_lang trans_unit_ctx.lang } ; lang= CFrontend_config.string_of_clang_lang trans_unit_ctx.lang }

@ -29,39 +29,35 @@ type t =
; tenv: Tenv.t ; tenv: Tenv.t
; cfg: Cfg.t ; cfg: Cfg.t
; procdesc: Procdesc.t ; procdesc: Procdesc.t
; is_objc_method: bool ; is_immediate_objc_method: bool
; curr_class: curr_class ; immediate_curr_class: curr_class
; return_param_typ: Typ.t option ; return_param_typ: Typ.t option
; outer_context: t option ; outer_context: t option
(** in case of objc blocks, the context of the method containing the
block *)
; mutable blocks_static_vars: (Pvar.t * Typ.t) list Typ.Procname.Map.t ; mutable blocks_static_vars: (Pvar.t * Typ.t) list Typ.Procname.Map.t
; label_map: str_node_map ; label_map: str_node_map
; vars_to_destroy: Clang_ast_t.decl list StmtMap.t } ; vars_to_destroy: Clang_ast_t.decl list StmtMap.t }
let create_context translation_unit_context tenv cfg procdesc curr_class return_param_typ let create_context translation_unit_context tenv cfg procdesc immediate_curr_class return_param_typ
is_objc_method outer_context vars_to_destroy = is_immediate_objc_method outer_context vars_to_destroy =
{ translation_unit_context { translation_unit_context
; tenv ; tenv
; cfg ; cfg
; procdesc ; procdesc
; curr_class ; immediate_curr_class
; return_param_typ ; return_param_typ
; is_objc_method ; is_immediate_objc_method
; outer_context ; outer_context
; blocks_static_vars= Typ.Procname.Map.empty ; blocks_static_vars= Typ.Procname.Map.empty
; label_map= Hashtbl.create 17 ; label_map= Hashtbl.create 17
; vars_to_destroy } ; vars_to_destroy }
let get_procdesc context = context.procdesc
let rec is_objc_method context = let rec is_objc_method context =
match context.outer_context with match context.outer_context with
| Some outer_context -> | Some outer_context ->
is_objc_method outer_context is_objc_method outer_context
| None -> | None ->
context.is_objc_method context.is_immediate_objc_method
let rec is_objc_instance context = let rec is_objc_instance context =
@ -75,11 +71,11 @@ let rec is_objc_instance context =
let rec get_curr_class context = let rec get_curr_class context =
match (context.curr_class, context.outer_context) with match (context.immediate_curr_class, context.outer_context) with
| ContextNoCls, Some outer_context -> | ContextNoCls, Some outer_context ->
get_curr_class outer_context get_curr_class outer_context
| _ -> | _ ->
context.curr_class context.immediate_curr_class
let get_curr_class_decl_ptr stmt_info curr_class = let get_curr_class_decl_ptr stmt_info curr_class =

@ -24,20 +24,18 @@ type t =
; tenv: Tenv.t ; tenv: Tenv.t
; cfg: Cfg.t ; cfg: Cfg.t
; procdesc: Procdesc.t ; procdesc: Procdesc.t
; is_objc_method: bool ; is_immediate_objc_method: bool
; curr_class: curr_class ; immediate_curr_class: curr_class
; return_param_typ: Typ.t option ; return_param_typ: Typ.t option
; outer_context: t option ; outer_context: t option
(** in case of objc blocks, the context of the method containing the (** in case of objc blocks, the context of the method containing the block *)
block *)
; mutable blocks_static_vars: (Pvar.t * Typ.t) list Typ.Procname.Map.t ; mutable blocks_static_vars: (Pvar.t * Typ.t) list Typ.Procname.Map.t
; label_map: str_node_map ; label_map: str_node_map
; vars_to_destroy: Clang_ast_t.decl list StmtMap.t ; vars_to_destroy: Clang_ast_t.decl list StmtMap.t
(* mapping from a statement to a list of variables, that go out of scope after the end of the statement *) (** mapping from a statement to a list of variables, that go out of scope after the end of the
statement *)
} }
val get_procdesc : t -> Procdesc.t
val get_curr_class : t -> curr_class val get_curr_class : t -> curr_class
val get_curr_class_typename : Clang_ast_t.stmt_info -> t -> Typ.Name.t val get_curr_class_typename : Clang_ast_t.stmt_info -> t -> Typ.Name.t

@ -13,19 +13,19 @@ module L = Logging
(* Helper functions *) (* Helper functions *)
let location_from_stmt lctx stmt = let location_from_stmt lctx stmt =
let info, _ = Clang_ast_proj.get_stmt_tuple stmt in let info, _ = Clang_ast_proj.get_stmt_tuple stmt in
CLocation.get_sil_location_from_range lctx.CLintersContext.translation_unit_context CLocation.location_of_source_range lctx.CLintersContext.translation_unit_context.source_file
info.Clang_ast_t.si_source_range true info.Clang_ast_t.si_source_range
let location_from_dinfo lctx info = let location_from_dinfo lctx info =
CLocation.get_sil_location_from_range lctx.CLintersContext.translation_unit_context CLocation.location_of_source_range lctx.CLintersContext.translation_unit_context.source_file
info.Clang_ast_t.di_source_range true info.Clang_ast_t.di_source_range
let location_from_decl lctx dec = let location_from_decl lctx dec =
let info = Clang_ast_proj.get_decl_tuple dec in let info = Clang_ast_proj.get_decl_tuple dec in
CLocation.get_sil_location_from_range lctx.CLintersContext.translation_unit_context CLocation.location_of_source_range lctx.CLintersContext.translation_unit_context.source_file
info.Clang_ast_t.di_source_range true info.Clang_ast_t.di_source_range
let location_from_an lcxt an = let location_from_an lcxt an =

@ -322,8 +322,8 @@ module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFron
in in
let translate_location = let translate_location =
always_translate always_translate
|| CLocation.should_translate_lib trans_unit_ctx source_range decl_trans_context || CLocation.should_translate_lib trans_unit_ctx.CFrontend_config.source_file source_range
~translate_when_used decl_trans_context ~translate_when_used
in in
let never_translate_decl = let never_translate_decl =
match dec with match dec with

@ -12,12 +12,12 @@ open PolyVariantEqual
(** Module for function to retrieve the location (file, line, etc) of instructions *) (** Module for function to retrieve the location (file, line, etc) of instructions *)
let clang_to_sil_location trans_unit_ctx clang_loc = let clang_to_sil_location default_source_file clang_loc =
let line = Option.value ~default:(-1) clang_loc.Clang_ast_t.sl_line in let line = Option.value ~default:(-1) clang_loc.Clang_ast_t.sl_line in
let col = Option.value ~default:(-1) clang_loc.Clang_ast_t.sl_column in let col = Option.value ~default:(-1) clang_loc.Clang_ast_t.sl_column in
let file = let file =
Option.value_map ~default:trans_unit_ctx.CFrontend_config.source_file Option.value_map ~default:default_source_file ~f:SourceFile.from_abs_path
~f:SourceFile.from_abs_path clang_loc.Clang_ast_t.sl_file clang_loc.Clang_ast_t.sl_file
in in
Location.{line; col; file} Location.{line; col; file}
@ -33,10 +33,10 @@ let source_file_in_project source_file =
file_in_project && not file_should_be_skipped file_in_project && not file_should_be_skipped
let should_do_frontend_check trans_unit_ctx (loc_start, _) = let should_do_frontend_check translation_unit (loc_start, _) =
match Option.map ~f:SourceFile.from_abs_path loc_start.Clang_ast_t.sl_file with match Option.map ~f:SourceFile.from_abs_path loc_start.Clang_ast_t.sl_file with
| Some source_file -> | Some source_file ->
SourceFile.equal source_file trans_unit_ctx.CFrontend_config.source_file SourceFile.equal translation_unit source_file
|| (source_file_in_project source_file && not Config.testing_mode) || (source_file_in_project source_file && not Config.testing_mode)
| None -> | None ->
false false
@ -46,7 +46,7 @@ let should_do_frontend_check trans_unit_ctx (loc_start, _) =
translate the headers that are part of the project. However, in testing mode, we don't want to translate the headers that are part of the project. However, in testing mode, we don't want to
translate the headers because the dot files in the frontend tests should contain nothing else translate the headers because the dot files in the frontend tests should contain nothing else
than the source file to avoid conflicts between different versions of the libraries. *) than the source file to avoid conflicts between different versions of the libraries. *)
let should_translate trans_unit_ctx (loc_start, loc_end) decl_trans_context ~translate_when_used = let should_translate translation_unit (loc_start, loc_end) decl_trans_context ~translate_when_used =
let map_file_of pred loc = let map_file_of pred loc =
match Option.map ~f:SourceFile.from_abs_path loc.Clang_ast_t.sl_file with match Option.map ~f:SourceFile.from_abs_path loc.Clang_ast_t.sl_file with
| Some f -> | Some f ->
@ -57,7 +57,7 @@ let should_translate trans_unit_ctx (loc_start, loc_end) decl_trans_context ~tra
(* it's not necessary to compare inodes here because both files come from (* it's not necessary to compare inodes here because both files come from
the same context - they are produced by the same invocation of ASTExporter the same context - they are produced by the same invocation of ASTExporter
which uses same logic to produce both files *) which uses same logic to produce both files *)
let equal_current_source = SourceFile.equal trans_unit_ctx.CFrontend_config.source_file in let equal_current_source = SourceFile.equal translation_unit in
let equal_header_of_current_source maybe_header = let equal_header_of_current_source maybe_header =
(* SourceFile.of_header will cache calls to filesystem *) (* SourceFile.of_header will cache calls to filesystem *)
let source_of_header_opt = SourceFile.of_header maybe_header in let source_of_header_opt = SourceFile.of_header maybe_header in
@ -76,9 +76,9 @@ let should_translate trans_unit_ctx (loc_start, loc_end) decl_trans_context ~tra
&& not Config.testing_mode && not Config.testing_mode
let should_translate_lib trans_unit_ctx source_range decl_trans_context ~translate_when_used = let should_translate_lib translation_unit source_range decl_trans_context ~translate_when_used =
not Config.no_translate_libs not Config.no_translate_libs
|| should_translate trans_unit_ctx source_range decl_trans_context ~translate_when_used || should_translate translation_unit source_range decl_trans_context ~translate_when_used
let is_file_blacklisted file = let is_file_blacklisted file =
@ -89,12 +89,10 @@ let is_file_blacklisted file =
is_file_blacklisted is_file_blacklisted
let get_sil_location_from_range trans_unit_ctx source_range prefer_first = let location_of_source_range ?(pick_location= `Start) default_source_file source_range =
let sloc1, sloc2 = source_range in source_range |> (match pick_location with `Start -> fst | `End -> snd)
let sloc = if not prefer_first then sloc2 else sloc1 in |> clang_to_sil_location default_source_file
clang_to_sil_location trans_unit_ctx sloc
let get_sil_location stmt_info context = let location_of_stmt_info default_source_file stmt_info =
let sloc1, _ = stmt_info.Clang_ast_t.si_source_range in location_of_source_range default_source_file stmt_info.Clang_ast_t.si_source_range
clang_to_sil_location context.CContext.translation_unit_context sloc1

@ -11,19 +11,18 @@ open! IStd
(** Module for function to retrieve the location (file, line, etc) of instructions *) (** Module for function to retrieve the location (file, line, etc) of instructions *)
val clang_to_sil_location : val clang_to_sil_location : SourceFile.t -> Clang_ast_t.source_location -> Location.t
CFrontend_config.translation_unit_context -> Clang_ast_t.source_location -> Location.t
val get_sil_location : Clang_ast_t.stmt_info -> CContext.t -> Location.t
val should_translate_lib : val should_translate_lib :
CFrontend_config.translation_unit_context -> Clang_ast_t.source_range SourceFile.t -> Clang_ast_t.source_range -> CModule_type.decl_trans_context
-> CModule_type.decl_trans_context -> translate_when_used:bool -> bool -> translate_when_used:bool -> bool
val should_do_frontend_check : val should_do_frontend_check : SourceFile.t -> Clang_ast_t.source_range -> bool
CFrontend_config.translation_unit_context -> Clang_ast_t.source_range -> bool
val is_file_blacklisted : string -> bool val is_file_blacklisted : string -> bool
val get_sil_location_from_range : val location_of_source_range :
CFrontend_config.translation_unit_context -> Clang_ast_t.source_range -> bool -> Location.t ?pick_location:[`Start | `End] -> SourceFile.t -> Clang_ast_t.source_range -> Location.t
(** picks the start of the source range by default *)
val location_of_stmt_info : SourceFile.t -> Clang_ast_t.stmt_info -> Location.t

@ -588,8 +588,13 @@ let create_local_procdesc ?(set_objc_accessor_attr= false) trans_unit_ctx cfg te
L.(debug Capture Verbose) L.(debug Capture Verbose)
"@\nbyvals = [ %s ]@\n@." "@\nbyvals = [ %s ]@\n@."
(String.concat ~sep:", " (List.map by_vals ~f:string_of_int)) ; (String.concat ~sep:", " (List.map by_vals ~f:string_of_int)) ;
let loc_start = CLocation.get_sil_location_from_range trans_unit_ctx source_range true in let loc_start =
let loc_exit = CLocation.get_sil_location_from_range trans_unit_ctx source_range false in CLocation.location_of_source_range trans_unit_ctx.CFrontend_config.source_file source_range
in
let loc_exit =
CLocation.location_of_source_range ~pick_location:`End
trans_unit_ctx.CFrontend_config.source_file source_range
in
let ret_type = get_return_type tenv ms in let ret_type = get_return_type tenv ms in
let objc_property_accessor = let objc_property_accessor =
if set_objc_accessor_attr then get_objc_property_accessor tenv ms else None if set_objc_accessor_attr then get_objc_property_accessor tenv ms else None

@ -120,7 +120,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let stmt_info, _ = Clang_ast_proj.get_stmt_tuple stmt in let stmt_info, _ = Clang_ast_proj.get_stmt_tuple stmt in
let stmt_info' = {stmt_info with Clang_ast_t.si_pointer= CAst_utils.get_fresh_pointer ()} in let stmt_info' = {stmt_info with Clang_ast_t.si_pointer= CAst_utils.get_fresh_pointer ()} in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info' in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info' in
let sil_loc = CLocation.get_sil_location stmt_info' trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info'
in
PriorityNode.compute_result_to_parent trans_state_pri sil_loc ~node_name:"Fallback node" PriorityNode.compute_result_to_parent trans_state_pri sil_loc ~node_name:"Fallback node"
stmt_info' res_trans stmt_info' res_trans
else res_trans else res_trans
@ -202,7 +205,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let context = trans_state.context in let context = trans_state.context in
let procdesc = context.CContext.procdesc in let procdesc = context.CContext.procdesc in
let pvar, typ = mk_temp_sil_var_for_expr context.CContext.tenv procdesc var_name expr_info in let pvar, typ = mk_temp_sil_var_for_expr context.CContext.tenv procdesc var_name expr_info in
let var_data : ProcAttributes.var_data = {name= Pvar.get_name pvar; typ; attributes= []} in let var_data = ProcAttributes.{name= Pvar.get_name pvar; typ; attributes= []} in
Procdesc.append_locals procdesc [var_data] ; Procdesc.append_locals procdesc [var_data] ;
(Exp.Lvar pvar, typ) (Exp.Lvar pvar, typ)
@ -286,8 +289,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let closure_trans closure_pname captured_vars context stmt_info expr_info = let closure_trans closure_pname captured_vars context stmt_info expr_info =
let loc = CLocation.get_sil_location stmt_info context in
let open CContext in let open CContext in
let loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let qual_type = expr_info.Clang_ast_t.ei_qual_type in let qual_type = expr_info.Clang_ast_t.ei_qual_type in
let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let ids_instrs = List.map ~f:(assign_captured_var loc) captured_vars in let ids_instrs = List.map ~f:(assign_captured_var loc) captured_vars in
@ -384,7 +389,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
| Some var_exp_typ -> | Some var_exp_typ ->
(* This node will always be child of InitListExpr, claiming priority will always fail *) (* This node will always be child of InitListExpr, claiming priority will always fail *)
let tenv = trans_state.context.CContext.tenv in let tenv = trans_state.context.CContext.tenv in
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info
trans_state.context.CContext.translation_unit_context.source_file stmt_info
in
(* Traverse structure of a type and initialize int/float/ptr fields with zero *) (* Traverse structure of a type and initialize int/float/ptr fields with zero *)
let rec fill_typ_with_zero ((exp, typ) as exp_typ) = let rec fill_typ_with_zero ((exp, typ) as exp_typ) =
match typ.Typ.desc with match typ.Typ.desc with
@ -446,7 +454,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
(* search the label into the hashtbl - create a fake node eventually *) (* search the label into the hashtbl - create a fake node eventually *)
(* connect that node with this stmt *) (* connect that node with this stmt *)
let gotoStmt_trans trans_state stmt_info label_name = let gotoStmt_trans trans_state stmt_info label_name =
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info
in
let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in
mk_trans_result (mk_fresh_void_exp_typ ()) mk_trans_result (mk_fresh_void_exp_typ ())
{empty_control with root_nodes= [root_node']; leaf_nodes= trans_state.succ_nodes} {empty_control with root_nodes= [root_node']; leaf_nodes= trans_state.succ_nodes}
@ -506,10 +517,12 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let field_deref_trans trans_state stmt_info pre_trans_result decl_ref ~is_constructor_init = let field_deref_trans trans_state stmt_info pre_trans_result decl_ref ~is_constructor_init =
let open CContext in let open CContext in
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let name_info, decl_ptr, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in let name_info, decl_ptr, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let field_string = name_info.Clang_ast_t.ni_name in let field_string = name_info.Clang_ast_t.ni_name in
L.(debug Capture Verbose) "!!!!! Dealing with field '%s' @." field_string ; L.(debug Capture Verbose) "Translating field '%s'@\n" field_string ;
let field_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in let field_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let obj_sil, class_typ = pre_trans_result.return in let obj_sil, class_typ = pre_trans_result.return in
let is_pointer_typ = Typ.is_pointer class_typ in let is_pointer_typ = Typ.is_pointer class_typ in
@ -561,7 +574,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
decl_ref stmt_info decl_kind = decl_ref stmt_info decl_kind =
let open CContext in let open CContext in
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let name_info, decl_ptr, _ = CAst_utils.get_info_from_decl_ref decl_ref in let name_info, decl_ptr, _ = CAst_utils.get_info_from_decl_ref decl_ref in
let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in
Option.iter ~f:(call_translation context) decl_opt ; Option.iter ~f:(call_translation context) decl_opt ;
@ -676,13 +691,15 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
None None
let get_this_pvar_typ stmt_info ?class_qual_type {CContext.curr_class; tenv; procdesc} = let get_this_pvar_typ stmt_info ?class_qual_type ({CContext.tenv; procdesc} as context) =
let class_qual_type = let class_qual_type =
match class_qual_type with match class_qual_type with
| Some class_qual_type -> | Some class_qual_type ->
class_qual_type class_qual_type
| None -> | None ->
let class_ptr = CContext.get_curr_class_decl_ptr stmt_info curr_class in let class_ptr =
CContext.get_curr_class_decl_ptr stmt_info (CContext.get_curr_class context)
in
Ast_expressions.create_pointer_qual_type (CAst_utils.qual_type_of_decl_ptr class_ptr) Ast_expressions.create_pointer_qual_type (CAst_utils.qual_type_of_decl_ptr class_ptr)
in in
let procname = Procdesc.get_proc_name procdesc in let procname = Procdesc.get_proc_name procdesc in
@ -695,15 +712,16 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let this_pvar, this_typ = get_this_pvar_typ stmt_info ?class_qual_type trans_state.context in let this_pvar, this_typ = get_this_pvar_typ stmt_info ?class_qual_type trans_state.context in
let return = (Exp.Lvar this_pvar, this_typ) in let return = (Exp.Lvar this_pvar, this_typ) in
(* there is no cast operation in AST, but backend needs it *) (* there is no cast operation in AST, but backend needs it *)
dereference_value_from_result sil_loc dereference_value_from_result stmt_info.Clang_ast_t.si_source_range sil_loc
(mk_trans_result return empty_control) (mk_trans_result return empty_control)
~strip_pointer:false
(** get the [this] of the current procedure *) (** get the [this] of the current procedure *)
let compute_this_expr trans_state stmt_info = let compute_this_expr trans_state stmt_info =
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let this_res_trans = this_expr_trans stmt_info trans_state sil_loc in let this_res_trans = this_expr_trans stmt_info trans_state sil_loc in
let obj_sil, class_typ = this_res_trans.return in let obj_sil, class_typ = this_res_trans.return in
let this_qual_type = match class_typ.desc with Typ.Tptr (t, _) -> t | _ -> class_typ in let this_qual_type = match class_typ.desc with Typ.Tptr (t, _) -> t | _ -> class_typ in
@ -711,7 +729,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let cxxThisExpr_trans trans_state stmt_info expr_info = let cxxThisExpr_trans trans_state stmt_info expr_info =
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info
in
this_expr_trans stmt_info trans_state sil_loc this_expr_trans stmt_info trans_state sil_loc
~class_qual_type:expr_info.Clang_ast_t.ei_qual_type ~class_qual_type:expr_info.Clang_ast_t.ei_qual_type
@ -727,7 +748,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
(* expected a stmt or at most a compoundstmt *) assert false (* expected a stmt or at most a compoundstmt *) assert false
in in
(* create the label root node into the hashtbl *) (* create the label root node into the hashtbl *)
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in
Procdesc.node_set_succs_exn context.procdesc root_node' res_trans.control.root_nodes [] ; Procdesc.node_set_succs_exn context.procdesc root_node' res_trans.control.root_nodes [] ;
mk_trans_result (mk_fresh_void_exp_typ ()) mk_trans_result (mk_fresh_void_exp_typ ())
@ -748,7 +771,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
ast_typ ast_typ
in in
let procname = Procdesc.get_proc_name context.procdesc in let procname = Procdesc.get_proc_name context.procdesc in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let pvar = let pvar =
CVar_decl.sil_var_of_decl_ref context stmt_info.Clang_ast_t.si_source_range decl_ref procname CVar_decl.sil_var_of_decl_ref context stmt_info.Clang_ast_t.si_source_range decl_ref procname
in in
@ -771,7 +796,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
match typ.desc with match typ.desc with
| Tptr (_, Pk_reference) -> | Tptr (_, Pk_reference) ->
(* dereference pvar due to the behavior of reference types in clang's AST *) (* dereference pvar due to the behavior of reference types in clang's AST *)
dereference_value_from_result sil_loc res_trans ~strip_pointer:false dereference_value_from_result stmt_info.Clang_ast_t.si_source_range sil_loc res_trans
| _ -> | _ ->
res_trans res_trans
@ -908,7 +933,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
"BinaryOperatorStmt: " ^ CArithmetic_trans.bin_op_to_string binary_operator_info "BinaryOperatorStmt: " ^ CArithmetic_trans.bin_op_to_string binary_operator_info
in in
let trans_state' = {trans_state_pri with succ_nodes= []} in let trans_state' = {trans_state_pri with succ_nodes= []} in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let res_typ = let res_typ =
CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type
in in
@ -972,7 +999,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let context = trans_state.context in let context = trans_state.context in
let fn_type_no_ref = CType_decl.get_type_from_expr_info expr_info context.CContext.tenv in let fn_type_no_ref = CType_decl.get_type_from_expr_info expr_info context.CContext.tenv in
let function_type = add_reference_if_glvalue fn_type_no_ref expr_info in let function_type = add_reference_if_glvalue fn_type_no_ref expr_info in
let sil_loc = CLocation.get_sil_location si context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file si
in
(* First stmt is the function expr and the rest are params *) (* First stmt is the function expr and the rest are params *)
let fun_exp_stmt, params_stmt = let fun_exp_stmt, params_stmt =
match stmt_list with fe :: params -> (fe, params) | _ -> assert false match stmt_list with fe :: params -> (fe, params) | _ -> assert false
@ -1012,7 +1041,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
match match
Option.bind callee_pname_opt Option.bind callee_pname_opt
~f: ~f:
(CTrans_utils.builtin_trans trans_state_pri sil_loc (CTrans_utils.builtin_trans trans_state_pri si.Clang_ast_t.si_source_range sil_loc
(res_trans_callee :: result_trans_params)) (res_trans_callee :: result_trans_params))
with with
| Some builtin -> | Some builtin ->
@ -1034,7 +1063,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and cxx_method_construct_call_trans trans_state_pri result_trans_callee params_stmt si and cxx_method_construct_call_trans trans_state_pri result_trans_callee params_stmt si
function_type is_cpp_call_virtual extra_res_trans ~is_inherited_ctor = function_type is_cpp_call_virtual extra_res_trans ~is_inherited_ctor =
let context = trans_state_pri.context in let context = trans_state_pri.context in
let sil_loc = CLocation.get_sil_location si context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file si
in
let callee_pname = Option.value_exn result_trans_callee.method_name in let callee_pname = Option.value_exn result_trans_callee.method_name in
(* As we may have nodes coming from different parameters we need to call instruction for each (* As we may have nodes coming from different parameters we need to call instruction for each
parameter and collect the results afterwards. The 'instructions' function does not do that *) parameter and collect the results afterwards. The 'instructions' function does not do that *)
@ -1046,7 +1077,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
in in
(* params including 'this' parameter *) (* params including 'this' parameter *)
let actual_params = collect_returns result_trans_params in let actual_params = collect_returns result_trans_params in
match cxx_method_builtin_trans trans_state_pri sil_loc result_trans_params callee_pname with match
cxx_method_builtin_trans trans_state_pri si.Clang_ast_t.si_source_range sil_loc
result_trans_params callee_pname
with
| Some builtin -> | Some builtin ->
builtin builtin
| None -> | None ->
@ -1087,7 +1121,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and cxxConstructExpr_trans trans_state si params_stmt ei cxx_constr_info ~is_inherited_ctor = and cxxConstructExpr_trans trans_state si params_stmt ei cxx_constr_info ~is_inherited_ctor =
let context = trans_state.context in let context = trans_state.context in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state si in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state si in
let sil_loc = CLocation.get_sil_location si context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file si
in
let decl_ref = cxx_constr_info.Clang_ast_t.xcei_decl_ref in let decl_ref = cxx_constr_info.Clang_ast_t.xcei_decl_ref in
let var_exp, class_type = let var_exp, class_type =
match trans_state.var_exp_typ with match trans_state.var_exp_typ with
@ -1124,7 +1160,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
false false
in in
if do_extra_deref then if do_extra_deref then
dereference_value_from_result sil_loc tmp_res_trans ~strip_pointer:false dereference_value_from_result si.Clang_ast_t.si_source_range sil_loc tmp_res_trans
else tmp_res_trans else tmp_res_trans
in in
let res_trans_callee = let res_trans_callee =
@ -1222,7 +1258,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
" priority node free = '%s'@\n@." " priority node free = '%s'@\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)) ; (string_of_bool (PriorityNode.is_priority_free trans_state)) ;
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location si context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file si
in
let method_type_no_ref = CType_decl.get_type_from_expr_info expr_info context.CContext.tenv in let method_type_no_ref = CType_decl.get_type_from_expr_info expr_info context.CContext.tenv in
let method_type = add_reference_if_glvalue method_type_no_ref expr_info in let method_type = add_reference_if_glvalue method_type_no_ref expr_info in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state si in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state si in
@ -1291,7 +1329,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
if not (CGeneral_utils.is_cpp_translation context.translation_unit_context) then None if not (CGeneral_utils.is_cpp_translation context.translation_unit_context) then None
else else
(* get virtual base classes of the current class *) (* get virtual base classes of the current class *)
let class_ptr = CContext.get_curr_class_decl_ptr stmt_info context.CContext.curr_class in let class_ptr =
CContext.get_curr_class_decl_ptr stmt_info (CContext.get_curr_class context)
in
let decl = Option.value_exn (CAst_utils.get_decl class_ptr) in let decl = Option.value_exn (CAst_utils.get_decl class_ptr) in
let typ_pointer_opt = CAst_utils.type_of_decl decl in let typ_pointer_opt = CAst_utils.type_of_decl decl in
let bases = CAst_utils.get_cxx_virtual_base_classes decl in let bases = CAst_utils.get_cxx_virtual_base_classes decl in
@ -1306,7 +1346,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
this_qual_type this_qual_type
in in
let all_res_trans = add_this_instrs_if_result_non_empty bases_res_trans this_res_trans in let all_res_trans = add_this_instrs_if_result_non_empty bases_res_trans this_res_trans in
let sil_loc = CLocation.get_sil_location stmt_info_loc context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info_loc
in
Some Some
(PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction" (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction"
stmt_info_loc ~return:(mk_fresh_void_exp_typ ()) all_res_trans) stmt_info_loc ~return:(mk_fresh_void_exp_typ ()) all_res_trans)
@ -1317,7 +1359,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
if not (CGeneral_utils.is_cpp_translation context.translation_unit_context) then None if not (CGeneral_utils.is_cpp_translation context.translation_unit_context) then None
else else
(* get fields and base classes of the current class *) (* get fields and base classes of the current class *)
let class_ptr = CContext.get_curr_class_decl_ptr stmt_info context.CContext.curr_class in let class_ptr =
CContext.get_curr_class_decl_ptr stmt_info (CContext.get_curr_class context)
in
let decl = Option.value_exn (CAst_utils.get_decl class_ptr) in let decl = Option.value_exn (CAst_utils.get_decl class_ptr) in
let fields = CAst_utils.get_record_fields decl in let fields = CAst_utils.get_record_fields decl in
let bases = CAst_utils.get_cxx_base_classes decl in let bases = CAst_utils.get_cxx_base_classes decl in
@ -1357,7 +1401,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let all_res_trans = let all_res_trans =
add_this_instrs_if_result_non_empty (all_res_trans @ bases_res_trans) this_res_trans add_this_instrs_if_result_non_empty (all_res_trans @ bases_res_trans) this_res_trans
in in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
Some Some
(PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction" (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction"
stmt_info' ~return:(mk_fresh_void_exp_typ ()) all_res_trans) stmt_info' ~return:(mk_fresh_void_exp_typ ()) all_res_trans)
@ -1397,7 +1443,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
L.(debug Capture Verbose) "@\n Variables that go out of scope are not found...@\n@." ; L.(debug Capture Verbose) "@\n Variables that go out of scope are not found...@\n@." ;
[] []
in in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
Some Some
(PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction" (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction"
stmt_info' ~return:(mk_fresh_void_exp_typ ()) all_res_trans) stmt_info' ~return:(mk_fresh_void_exp_typ ()) all_res_trans)
@ -1437,7 +1485,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let context = trans_state.context in let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in let succ_nodes = trans_state.succ_nodes in
let procdesc = context.CContext.procdesc in let procdesc = context.CContext.procdesc in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let do_branch branch stmt var_typ prune_nodes join_node pvar = let do_branch branch stmt var_typ prune_nodes join_node pvar =
let trans_state_pri = PriorityNode.force_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.force_claim_priority_node trans_state stmt_info in
let trans_state' = {trans_state_pri with succ_nodes= []} in let trans_state' = {trans_state_pri with succ_nodes= []} in
@ -1473,12 +1523,13 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type
in in
let var_typ = add_reference_if_glvalue typ expr_info in let var_typ = add_reference_if_glvalue typ expr_info in
let join_node = create_node Procdesc.Node.Join_node [] sil_loc context in let join_node =
Procdesc.create_node trans_state.context.CContext.procdesc sil_loc
Procdesc.Node.Join_node []
in
Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [] ; Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [] ;
let pvar = mk_temp_sil_var procdesc "SIL_temp_conditional___" in let pvar = mk_temp_sil_var procdesc "SIL_temp_conditional___" in
let var_data : ProcAttributes.var_data = let var_data = ProcAttributes.{name= Pvar.get_name pvar; typ= var_typ; attributes= []} in
{name= Pvar.get_name pvar; typ= var_typ; attributes= []}
in
Procdesc.append_locals procdesc [var_data] ; Procdesc.append_locals procdesc [var_data] ;
let continuation' = mk_cond_continuation trans_state.continuation in let continuation' = mk_cond_continuation trans_state.continuation in
let trans_state' = {trans_state with continuation= continuation'; succ_nodes= []} in let trans_state' = {trans_state with continuation= continuation'; succ_nodes= []} in
@ -1506,7 +1557,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
match stmt_list with match stmt_list with
| [stmt1; ostmt1; ostmt2; stmt2] | [stmt1; ostmt1; ostmt2; stmt2]
when contains_opaque_value_expr ostmt1 && contains_opaque_value_expr ostmt2 -> when contains_opaque_value_expr ostmt1 && contains_opaque_value_expr ostmt2 ->
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info
in
let trans_state_pri = PriorityNode.force_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.force_claim_priority_node trans_state stmt_info in
let trans_state_cond = let trans_state_cond =
{trans_state_pri with continuation= mk_cond_continuation trans_state_pri.continuation} {trans_state_pri with continuation= mk_cond_continuation trans_state_pri.continuation}
@ -1537,10 +1591,13 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
always the leaf nodes of the translation. *) always the leaf nodes of the translation. *)
and cond_trans ~if_kind ~negate_cond trans_state cond : trans_result = and cond_trans ~if_kind ~negate_cond trans_state cond : trans_result =
let context = trans_state.context in let context = trans_state.context in
let si, _ = Clang_ast_proj.get_stmt_tuple cond in let cond_source_range = source_range_of_stmt cond in
let sil_loc = CLocation.get_sil_location si context in let sil_loc =
CLocation.location_of_source_range context.translation_unit_context.source_file
cond_source_range
in
let mk_prune_node ~branch ~negate_cond e ins = let mk_prune_node ~branch ~negate_cond e ins =
create_prune_node ~branch ~negate_cond e ins sil_loc if_kind context create_prune_node context.procdesc ~branch ~negate_cond e ins sil_loc if_kind
in in
(* this function translate cond without doing shortcircuit *) (* this function translate cond without doing shortcircuit *)
let no_short_circuit_cond ~is_cmp = let no_short_circuit_cond ~is_cmp =
@ -1566,7 +1623,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
instruction trans_state cond instruction trans_state cond
else instruction trans_state cond else instruction trans_state cond
in in
let e', instrs' = let ((e', _) as return), instrs' =
define_condition_side_effects res_trans_cond.return res_trans_cond.control.instrs sil_loc define_condition_side_effects res_trans_cond.return res_trans_cond.control.instrs sil_loc
in in
let prune_t = mk_prune_node ~branch:true ~negate_cond e' instrs' in let prune_t = mk_prune_node ~branch:true ~negate_cond e' instrs' in
@ -1578,7 +1635,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
if List.is_empty res_trans_cond.control.root_nodes then [prune_t; prune_f] if List.is_empty res_trans_cond.control.root_nodes then [prune_t; prune_f]
else res_trans_cond.control.root_nodes else res_trans_cond.control.root_nodes
in in
mk_trans_result e' mk_trans_result return
{empty_control with root_nodes; leaf_nodes= [prune_t; prune_f]; instrs= instrs'} {empty_control with root_nodes; leaf_nodes= [prune_t; prune_f]; instrs= instrs'}
in in
(* This function translate (s1 binop s2) doing shortcircuit for '&&' and '||' *) (* This function translate (s1 binop s2) doing shortcircuit for '&&' and '||' *)
@ -1659,8 +1716,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and ifStmt_trans trans_state stmt_info stmt_list = and ifStmt_trans trans_state stmt_info stmt_list =
let context = trans_state.context in let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in let succ_nodes = trans_state.succ_nodes in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
let join_node = create_node Procdesc.Node.Join_node [] sil_loc context in CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let join_node = Procdesc.create_node context.procdesc sil_loc Procdesc.Node.Join_node [] in
Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [] ; Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [] ;
let trans_state' = {trans_state with succ_nodes= [join_node]} in let trans_state' = {trans_state with succ_nodes= [join_node]} in
let do_branch branch stmt_branch prune_nodes = let do_branch branch stmt_branch prune_nodes =
@ -1669,8 +1728,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let nodes_branch = let nodes_branch =
match res_trans_b.control.root_nodes with match res_trans_b.control.root_nodes with
| [] -> | [] ->
[ create_node (Procdesc.Node.Stmt_node "IfStmt Branch") res_trans_b.control.instrs [ Procdesc.create_node context.procdesc sil_loc
sil_loc context ] (Procdesc.Node.Stmt_node "IfStmt Branch") res_trans_b.control.instrs ]
| _ -> | _ ->
res_trans_b.control.root_nodes res_trans_b.control.root_nodes
in in
@ -1702,7 +1761,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let context = trans_state.context in let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in let succ_nodes = trans_state.succ_nodes in
let continuation = trans_state.continuation in let continuation = trans_state.continuation in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let open Clang_ast_t in let open Clang_ast_t in
match switch_stmt_list with match switch_stmt_list with
| [_; decl_stmt; cond; CompoundStmt (stmt_info, stmt_list)] -> | [_; decl_stmt; cond; CompoundStmt (stmt_info, stmt_list)] ->
@ -1711,7 +1772,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let res_trans_cond_tmp = instruction trans_state' cond in let res_trans_cond_tmp = instruction trans_state' cond in
let switch_special_cond_node = let switch_special_cond_node =
let node_kind = Procdesc.Node.Stmt_node "Switch_stmt" in let node_kind = Procdesc.Node.Stmt_node "Switch_stmt" in
create_node node_kind res_trans_cond_tmp.control.instrs sil_loc context Procdesc.create_node context.procdesc sil_loc node_kind res_trans_cond_tmp.control.instrs
in in
List.iter List.iter
~f:(fun n' -> ~f:(fun n' ->
@ -1721,7 +1782,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
if res_trans_cond_tmp.control.root_nodes <> [] then res_trans_cond_tmp.control.root_nodes if res_trans_cond_tmp.control.root_nodes <> [] then res_trans_cond_tmp.control.root_nodes
else [switch_special_cond_node] else [switch_special_cond_node]
in in
let switch_e_cond', switch_e_cond'_typ = res_trans_cond_tmp.return in let switch_e_cond', _ = res_trans_cond_tmp.return in
let res_trans_cond = let res_trans_cond =
{ res_trans_cond_tmp with { res_trans_cond_tmp with
control= control=
@ -1802,16 +1863,17 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let res_trans_case_const = instruction trans_state_pri case_const in let res_trans_case_const = instruction trans_state_pri case_const in
let e_const, _ = res_trans_case_const.return in let e_const, _ = res_trans_case_const.return in
let sil_eq_cond = Exp.BinOp (Binop.Eq, switch_e_cond', e_const) in let sil_eq_cond = Exp.BinOp (Binop.Eq, switch_e_cond', e_const) in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file
stmt_info
in
let true_prune_node = let true_prune_node =
create_prune_node ~branch:true ~negate_cond:false create_prune_node context.procdesc ~branch:true ~negate_cond:false sil_eq_cond
(sil_eq_cond, switch_e_cond'_typ) res_trans_case_const.control.instrs sil_loc res_trans_case_const.control.instrs sil_loc Sil.Ik_switch
Sil.Ik_switch context
in in
let false_prune_node = let false_prune_node =
create_prune_node ~branch:false ~negate_cond:true create_prune_node context.procdesc ~branch:false ~negate_cond:true sil_eq_cond
(sil_eq_cond, switch_e_cond'_typ) res_trans_case_const.control.instrs sil_loc res_trans_case_const.control.instrs sil_loc Sil.Ik_switch
Sil.Ik_switch context
in in
(true_prune_node, false_prune_node) (true_prune_node, false_prune_node)
| _ -> | _ ->
@ -1832,9 +1894,13 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
Procdesc.node_set_succs_exn context.procdesc prune_node_f last_prune_nodes [] ; Procdesc.node_set_succs_exn context.procdesc prune_node_f last_prune_nodes [] ;
(case_entry_point, [prune_node_t; prune_node_f]) (case_entry_point, [prune_node_t; prune_node_f])
| DefaultStmt (stmt_info, default_content) :: rest -> | DefaultStmt (stmt_info, default_content) :: rest ->
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file
stmt_info
in
let placeholder_entry_point = let placeholder_entry_point =
create_node (Procdesc.Node.Stmt_node "DefaultStmt_placeholder") [] sil_loc context Procdesc.create_node context.procdesc sil_loc
(Procdesc.Node.Stmt_node "DefaultStmt_placeholder") []
in in
let last_nodes, last_prune_nodes = let last_nodes, last_prune_nodes =
translate_and_connect_cases rest next_nodes [placeholder_entry_point] translate_and_connect_cases rest next_nodes [placeholder_entry_point]
@ -1865,8 +1931,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
switch_stmt_list switch_stmt_list
and stmtExpr_trans trans_state stmt_list = and stmtExpr_trans trans_state source_range stmt_list =
let stmt = extract_stmt_from_singleton stmt_list "StmtExpr should have only one statement." in let stmt =
extract_stmt_from_singleton stmt_list source_range "StmtExpr should have only one statement."
in
let trans_state' = {trans_state with priority= Free} in let trans_state' = {trans_state with priority= Free} in
instruction trans_state' stmt instruction trans_state' stmt
@ -1875,8 +1943,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let outer_continuation = trans_state.continuation in let outer_continuation = trans_state.continuation in
let context = trans_state.context in let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in let succ_nodes = trans_state.succ_nodes in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
let join_node = create_node Procdesc.Node.Join_node [] sil_loc context in CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let join_node = Procdesc.create_node context.procdesc sil_loc Procdesc.Node.Join_node [] in
let continuation = Some {break= succ_nodes; continue= [join_node]; return_temp= false} in let continuation = Some {break= succ_nodes; continue= [join_node]; return_temp= false} in
(* set the flag to inform that we are translating a condition of a if *) (* set the flag to inform that we are translating a condition of a if *)
let continuation_cond = mk_cond_continuation outer_continuation in let continuation_cond = mk_cond_continuation outer_continuation in
@ -2099,7 +2169,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let return = (return_exp, var_typ) in let return = (return_exp, var_typ) in
mk_trans_result return {empty_control with root_nodes= trans_state.succ_nodes} mk_trans_result return {empty_control with root_nodes= trans_state.succ_nodes}
else else
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info
in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let init_stmt_info = let init_stmt_info =
{stmt_info with Clang_ast_t.si_pointer= CAst_utils.get_fresh_pointer ()} {stmt_info with Clang_ast_t.si_pointer= CAst_utils.get_fresh_pointer ()}
@ -2132,7 +2205,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state array_stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state array_stmt_info in
let dynlength_trans_result = instruction trans_state_pri dynlength_stmt in let dynlength_trans_result = instruction trans_state_pri dynlength_stmt in
let dynlength_exp_typ = dynlength_trans_result.return in let dynlength_exp_typ = dynlength_trans_result.return in
let sil_loc = CLocation.get_sil_location dynlength_stmt_info trans_state_pri.context in let sil_loc =
CLocation.location_of_stmt_info trans_state_pri.context.translation_unit_context.source_file
dynlength_stmt_info
in
let ret_id_typ, ret_exp_typ = mk_fresh_void_return () in let ret_id_typ, ret_exp_typ = mk_fresh_void_return () in
let call_instr = let call_instr =
let call_exp = Exp.Const (Const.Cfun BuiltinDecl.__set_array_length) in let call_exp = Exp.Const (Const.Cfun BuiltinDecl.__set_array_length) in
@ -2164,7 +2240,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
(*For init expr, translate how to compute it and assign to the var*) (*For init expr, translate how to compute it and assign to the var*)
let var_exp, _ = var_exp_typ in let var_exp, _ = var_exp_typ in
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location var_stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file
var_stmt_info
in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state var_stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state var_stmt_info in
(* if ie is a block the translation need to be done (* if ie is a block the translation need to be done
with the block special cases by exec_with_block_priority *) with the block special cases by exec_with_block_priority *)
@ -2325,9 +2404,11 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
L.(debug Capture Verbose) L.(debug Capture Verbose)
" priority node free = '%s'@\n@." " priority node free = '%s'@\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)) ; (string_of_bool (PriorityNode.is_priority_free trans_state)) ;
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let stmt = let stmt =
extract_stmt_from_singleton stmt_list extract_stmt_from_singleton stmt_list stmt_info.Clang_ast_t.si_source_range
"In CastExpr There must be only one stmt defining the expression to be cast." "In CastExpr There must be only one stmt defining the expression to be cast."
in in
let res_trans_stmt = instruction trans_state stmt in let res_trans_stmt = instruction trans_state stmt in
@ -2346,7 +2427,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
(** function used in the computation for both Member_Expr and ObjCIVarRefExpr *) (** function used in the computation for both Member_Expr and ObjCIVarRefExpr *)
and do_memb_ivar_ref_exp trans_state stmt_info stmt_list decl_ref = and do_memb_ivar_ref_exp trans_state stmt_info stmt_list decl_ref =
let exp_stmt = let exp_stmt =
extract_stmt_from_singleton stmt_list extract_stmt_from_singleton stmt_list stmt_info.Clang_ast_t.si_source_range
"in MemberExpr there must be only one stmt defining its expression." "in MemberExpr there must be only one stmt defining its expression."
in in
(* Don't pass var_exp_typ to child of MemberExpr - this may lead to initializing variable *) (* Don't pass var_exp_typ to child of MemberExpr - this may lead to initializing variable *)
@ -2371,10 +2452,12 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and unaryOperator_trans trans_state stmt_info expr_info stmt_list unary_operator_info = and unaryOperator_trans trans_state stmt_info expr_info stmt_list unary_operator_info =
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let stmt = let stmt =
extract_stmt_from_singleton stmt_list extract_stmt_from_singleton stmt_list stmt_info.Clang_ast_t.si_source_range
"We expect only one element in stmt list defining the operand in UnaryOperator." "We expect only one element in stmt list defining the operand in UnaryOperator."
in in
let trans_state' = {trans_state_pri with succ_nodes= []} in let trans_state' = {trans_state_pri with succ_nodes= []} in
@ -2397,7 +2480,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and returnStmt_trans trans_state stmt_info stmt_list = and returnStmt_trans trans_state stmt_info stmt_list =
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let procdesc = context.CContext.procdesc in let procdesc = context.CContext.procdesc in
let procname = Procdesc.get_proc_name procdesc in let procname = Procdesc.get_proc_name procdesc in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
@ -2430,9 +2515,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
check_destructor_translation destructor_res ; check_destructor_translation destructor_res ;
let instrs_of = function Some {control= {instrs}} -> instrs | None -> [] in let instrs_of = function Some {control= {instrs}} -> instrs | None -> [] in
let ret_node = let ret_node =
create_node (Procdesc.Node.Stmt_node "Return Stmt") Procdesc.create_node context.procdesc sil_loc (Procdesc.Node.Stmt_node "Return Stmt")
(instrs @ instrs_of destr_trans_result @ instrs_of destructor_res) (instrs @ instrs_of destr_trans_result @ instrs_of destructor_res)
sil_loc context
in in
Procdesc.node_set_succs_exn context.procdesc ret_node Procdesc.node_set_succs_exn context.procdesc ret_node
[Procdesc.get_exit_node context.CContext.procdesc] [Procdesc.get_exit_node context.CContext.procdesc]
@ -2495,9 +2579,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
later on (when we treat ARC) some info can be taken from it. For ParenExpression we translate later on (when we treat ARC) some info can be taken from it. For ParenExpression we translate
its body composed by the stmt_list. In paren expression there should be only one stmt that its body composed by the stmt_list. In paren expression there should be only one stmt that
defines the expression *) defines the expression *)
and parenExpr_trans trans_state stmt_list = and parenExpr_trans trans_state source_range stmt_list =
let stmt = let stmt =
extract_stmt_from_singleton stmt_list extract_stmt_from_singleton stmt_list source_range
"WARNING: In ParenExpression there should be only one stmt." "WARNING: In ParenExpression there should be only one stmt."
in in
instruction trans_state stmt instruction trans_state stmt
@ -2622,7 +2706,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
in in
let translate_normal_capture ~is_by_ref ((pvar, typ) as pvar_typ) let translate_normal_capture ~is_by_ref ((pvar, typ) as pvar_typ)
(trans_results_acc, captured_vars_acc) = (trans_results_acc, captured_vars_acc) =
let loc = CLocation.get_sil_location stmt_info context in let loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
if is_by_ref then (trans_results_acc, (Exp.Lvar pvar, pvar, typ) :: captured_vars_acc) if is_by_ref then (trans_results_acc, (Exp.Lvar pvar, pvar, typ) :: captured_vars_acc)
else else
let id, instr = assign_captured_var loc pvar_typ in let id, instr = assign_captured_var loc pvar_typ in
@ -2682,7 +2768,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and cxxNewExpr_trans trans_state stmt_info expr_info cxx_new_expr_info = and cxxNewExpr_trans trans_state stmt_info expr_info cxx_new_expr_info =
let context = trans_state.context in let context = trans_state.context in
let typ = CType_decl.get_type_from_expr_info expr_info context.tenv in let typ = CType_decl.get_type_from_expr_info expr_info context.tenv in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let is_dyn_array = cxx_new_expr_info.Clang_ast_t.xnei_is_array in let is_dyn_array = cxx_new_expr_info.Clang_ast_t.xnei_is_array in
let source_range = stmt_info.Clang_ast_t.si_source_range in let source_range = stmt_info.Clang_ast_t.si_source_range in
@ -2761,7 +2849,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and cxxDeleteExpr_trans trans_state stmt_info stmt_list delete_expr_info = and cxxDeleteExpr_trans trans_state stmt_info stmt_list delete_expr_info =
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let is_array = delete_expr_info.Clang_ast_t.xdei_is_array in let is_array = delete_expr_info.Clang_ast_t.xdei_is_array in
let fname = if is_array then BuiltinDecl.__delete_array else BuiltinDecl.__delete in let fname = if is_array then BuiltinDecl.__delete_array else BuiltinDecl.__delete in
let param = match stmt_list with [p] -> p | _ -> assert false in let param = match stmt_list with [p] -> p | _ -> assert false in
@ -2814,7 +2904,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let var_exp_typ = (Exp.Lvar pvar, typ_tmp) in let var_exp_typ = (Exp.Lvar pvar, typ_tmp) in
let res_trans = init_expr_trans trans_state var_exp_typ stmt_info (Some temp_exp) in let res_trans = init_expr_trans trans_state var_exp_typ stmt_info (Some temp_exp) in
let _, typ = res_trans.return in let _, typ = res_trans.return in
let var_data : ProcAttributes.var_data = {name= Pvar.get_name pvar; typ; attributes= []} in let var_data = ProcAttributes.{name= Pvar.get_name pvar; typ; attributes= []} in
Procdesc.append_locals procdesc [var_data] ; Procdesc.append_locals procdesc [var_data] ;
res_trans res_trans
@ -2835,7 +2925,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let context = trans_state.context in let context = trans_state.context in
let subtype = Subtype.subtypes_cast in let subtype = Subtype.subtypes_cast in
let tenv = context.CContext.tenv in let tenv = context.CContext.tenv in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc =
CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info
in
let cast_type = CType_decl.qual_type_to_sil_type tenv cast_qual_type in let cast_type = CType_decl.qual_type_to_sil_type tenv cast_qual_type in
let sizeof_expr = let sizeof_expr =
match cast_type.desc with match cast_type.desc with
@ -2868,7 +2960,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and call_function_with_args instr_name pname trans_state stmt_info ret_typ stmts = and call_function_with_args instr_name pname trans_state stmt_info ret_typ stmts =
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info
in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let trans_state_param = {trans_state_pri with succ_nodes= []} in let trans_state_param = {trans_state_pri with succ_nodes= []} in
let res_trans_subexpr_list = let res_trans_subexpr_list =
@ -2909,7 +3004,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and cxxTypeidExpr_trans trans_state stmt_info stmts expr_info = and cxxTypeidExpr_trans trans_state stmt_info stmts expr_info =
let tenv = trans_state.context.CContext.tenv in let tenv = trans_state.context.CContext.tenv in
let typ = CType_decl.get_type_from_expr_info expr_info tenv in let typ = CType_decl.get_type_from_expr_info expr_info tenv in
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info
in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let res_trans_subexpr = let res_trans_subexpr =
match stmts with match stmts with
@ -2955,7 +3053,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
and cxxStdInitializerListExpr_trans trans_state stmt_info stmts expr_info = and cxxStdInitializerListExpr_trans trans_state stmt_info stmts expr_info =
let context = trans_state.context in let context = trans_state.context in
let tenv = context.CContext.tenv in let tenv = context.CContext.tenv in
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc =
CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file
stmt_info
in
let typ = CType_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in let typ = CType_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in
let fun_name = Typ.Procname.from_string_c_fun CFrontend_config.infer_skip_fun in let fun_name = Typ.Procname.from_string_c_fun CFrontend_config.infer_skip_fun in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
@ -3113,8 +3214,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
"Case statement outside of switch statement: %a" "Case statement outside of switch statement: %a"
(Pp.to_string ~f:Clang_ast_j.string_of_stmt) (Pp.to_string ~f:Clang_ast_j.string_of_stmt)
instr instr
| StmtExpr (_, stmt_list, _) -> | StmtExpr ({Clang_ast_t.si_source_range}, stmt_list, _) ->
stmtExpr_trans trans_state stmt_list stmtExpr_trans trans_state si_source_range stmt_list
| ForStmt (stmt_info, [init; decl_stmt; condition; increment; body]) -> | ForStmt (stmt_info, [init; decl_stmt; condition; increment; body]) ->
forStmt_trans trans_state ~init ~decl_stmt ~condition ~increment ~body stmt_info forStmt_trans trans_state ~init ~decl_stmt ~condition ~increment ~body stmt_info
| WhileStmt (stmt_info, [decl_stmt; condition; body]) -> | WhileStmt (stmt_info, [decl_stmt; condition; body]) ->
@ -3184,9 +3285,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
returnStmt_trans trans_state stmt_info stmt_list returnStmt_trans trans_state stmt_info stmt_list
(* We analyze the content of the expr. We treat ExprWithCleanups as a wrapper. *) (* We analyze the content of the expr. We treat ExprWithCleanups as a wrapper. *)
(* It may be that later on (when we treat ARC) some info can be taken from it. *) (* It may be that later on (when we treat ARC) some info can be taken from it. *)
| ExprWithCleanups (_, stmt_list, _, _) | ExprWithCleanups ({Clang_ast_t.si_source_range}, stmt_list, _, _)
| ParenExpr (_, stmt_list, _) -> | ParenExpr ({Clang_ast_t.si_source_range}, stmt_list, _) ->
parenExpr_trans trans_state stmt_list parenExpr_trans trans_state si_source_range stmt_list
| ObjCBoolLiteralExpr (_, _, expr_info, n) | ObjCBoolLiteralExpr (_, _, expr_info, n)
| CharacterLiteral (_, _, expr_info, n) | CharacterLiteral (_, _, expr_info, n)
| CXXBoolLiteralExpr (_, _, expr_info, n) -> | CXXBoolLiteralExpr (_, _, expr_info, n) ->
@ -3247,9 +3348,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
compoundLiteralExpr_trans trans_state stmt_list expr_info compoundLiteralExpr_trans trans_state stmt_list expr_info
| InitListExpr (stmt_info, stmts, expr_info) -> | InitListExpr (stmt_info, stmts, expr_info) ->
initListExpr_trans trans_state stmt_info expr_info stmts initListExpr_trans trans_state stmt_info expr_info stmts
| CXXBindTemporaryExpr (_, stmt_list, _, _) -> | CXXBindTemporaryExpr ({Clang_ast_t.si_source_range}, stmt_list, _, _) ->
(* right now we ignore this expression and try to translate the child node *) (* right now we ignore this expression and try to translate the child node *)
parenExpr_trans trans_state stmt_list parenExpr_trans trans_state si_source_range stmt_list
| CXXDynamicCastExpr (stmt_info, stmts, _, _, qual_type, _) -> | CXXDynamicCastExpr (stmt_info, stmts, _, _, qual_type, _) ->
cxxDynamicCastExpr_trans trans_state stmt_info stmts qual_type cxxDynamicCastExpr_trans trans_state stmt_info stmts qual_type
| CXXDefaultArgExpr (_, _, _, default_expr_info) | CXXDefaultArgExpr (_, _, _, default_expr_info)
@ -3424,8 +3525,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let context = trans_state.context in let context = trans_state.context in
let source_range = ctor_init.Clang_ast_t.xci_source_range in let source_range = ctor_init.Clang_ast_t.xci_source_range in
let sil_loc = let sil_loc =
CLocation.get_sil_location_from_range context.CContext.translation_unit_context source_range CLocation.location_of_source_range context.CContext.translation_unit_context.source_file
true source_range
in in
(* its pointer will be used in PriorityNode *) (* its pointer will be used in PriorityNode *)
let this_stmt_info = CAst_utils.dummy_stmt_info () in let this_stmt_info = CAst_utils.dummy_stmt_info () in

@ -14,14 +14,20 @@ module Hashtbl = Caml.Hashtbl
module L = Logging module L = Logging
(** Extract the element of a singleton list. If the list is not a singleton it crashes *) (** Extract the element of a singleton list. If the list is not a singleton it crashes. *)
let extract_item_from_singleton l pp warning_string = let extract_item_from_singleton l pp source_range warning_string =
match l with match l with
| [item] -> | [item] ->
item item
| _ -> | _ ->
L.die InternalError "List has %d elements, 1 expected:@\n[@[<h>%a@]]@\n%s" (List.length l) L.die InternalError "At %a: List has %d elements, 1 expected:@\n[@[<h>%a@]]@\n%s"
(Pp.semicolon_seq pp) l warning_string (Pp.to_string ~f:Clang_ast_j.string_of_source_range)
source_range (List.length l) (Pp.semicolon_seq pp) l warning_string
let source_range_of_stmt stmt =
let {Clang_ast_t.si_source_range}, _ = Clang_ast_proj.get_stmt_tuple stmt in
si_source_range
module Nodes = struct module Nodes = struct
@ -35,15 +41,10 @@ module Nodes = struct
false false
let create_node node_kind instrs loc context = let create_prune_node proc_desc ~branch ~negate_cond e_cond instrs_cond loc if_kind =
let procdesc = CContext.get_procdesc context in
Procdesc.create_node procdesc loc node_kind instrs
let create_prune_node ~branch ~negate_cond (e_cond, _) instrs_cond loc if_kind context =
let e_cond = if negate_cond then Exp.UnOp (Unop.LNot, e_cond, None) else e_cond in let e_cond = if negate_cond then Exp.UnOp (Unop.LNot, e_cond, None) else e_cond in
let instrs_cond' = instrs_cond @ [Sil.Prune (e_cond, loc, branch, if_kind)] in let instrs_cond' = instrs_cond @ [Sil.Prune (e_cond, loc, branch, if_kind)] in
create_node (prune_kind branch if_kind) instrs_cond' loc context Procdesc.create_node proc_desc loc (prune_kind branch if_kind) instrs_cond'
(** Check if this binary opertor requires the creation of a node in the cfg. *) (** Check if this binary opertor requires the creation of a node in the cfg. *)
@ -90,7 +91,10 @@ module GotoLabel = struct
let find_goto_label context label sil_loc = let find_goto_label context label sil_loc =
try Hashtbl.find context.CContext.label_map label with Caml.Not_found -> try Hashtbl.find context.CContext.label_map label with Caml.Not_found ->
let node_name = Format.sprintf "GotoLabel_%s" label in let node_name = Format.sprintf "GotoLabel_%s" label in
let new_node = Nodes.create_node (Procdesc.Node.Skip_node node_name) [] sil_loc context in let new_node =
Procdesc.create_node context.CContext.procdesc sil_loc (Procdesc.Node.Skip_node node_name)
[]
in
Hashtbl.add context.CContext.label_map label new_node ; Hashtbl.add context.CContext.label_map label new_node ;
new_node new_node
end end
@ -214,7 +218,9 @@ module PriorityNode = struct
if create_node then ( if create_node then (
(* We need to create a node *) (* We need to create a node *)
let node_kind = Procdesc.Node.Stmt_node node_name in let node_kind = Procdesc.Node.Stmt_node node_name in
let node = Nodes.create_node node_kind res_state.instrs loc trans_state.context in let node =
Procdesc.create_node trans_state.context.CContext.procdesc loc node_kind res_state.instrs
in
Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes [] ; Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes [] ;
List.iter List.iter
~f:(fun leaf -> Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] []) ~f:(fun leaf -> Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] [])
@ -440,17 +446,14 @@ let dereference_var_sil (exp, typ) sil_loc =
([sil_instr], Exp.Var id) ([sil_instr], Exp.Var id)
(** Given trans_result with ONE expression, create temporary variable with value of an expression let dereference_value_from_result ?(strip_pointer= false) source_range sil_loc trans_result =
assigned to it *)
let dereference_value_from_result sil_loc trans_result ~strip_pointer =
let obj_sil, class_typ = trans_result.return in let obj_sil, class_typ = trans_result.return in
let typ_no_ptr = let typ_no_ptr =
match class_typ.Typ.desc with match class_typ.Typ.desc with
| Tptr (typ, _) -> | Tptr (typ, _) ->
typ typ
| _ -> | _ ->
CFrontend_config.incorrect_assumption __POS__ CFrontend_config.incorrect_assumption __POS__ source_range
(CAst_utils.dummy_source_range ())
"Expected pointer type but found type %a" (Typ.pp_full Pp.text) class_typ "Expected pointer type but found type %a" (Typ.pp_full Pp.text) class_typ
in in
let cast_typ = if strip_pointer then typ_no_ptr else class_typ in let cast_typ = if strip_pointer then typ_no_ptr else class_typ in
@ -494,9 +497,10 @@ let trans_assertion_failure sil_loc (context: CContext.t) =
let call_instr = let call_instr =
Sil.Call ((ret_id, ret_typ), assert_fail_builtin, args, sil_loc, CallFlags.default) Sil.Call ((ret_id, ret_typ), assert_fail_builtin, args, sil_loc, CallFlags.default)
in in
let exit_node = Procdesc.get_exit_node (CContext.get_procdesc context) let exit_node = Procdesc.get_exit_node context.procdesc
and failure_node = and failure_node =
Nodes.create_node (Procdesc.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context Procdesc.create_node context.CContext.procdesc sil_loc
(Procdesc.Node.Stmt_node "Assertion failure") [call_instr]
in in
Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] [] ; Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] [] ;
mk_trans_result (Exp.Var ret_id, ret_typ) {empty_control with root_nodes= [failure_node]} mk_trans_result (Exp.Var ret_id, ret_typ) {empty_control with root_nodes= [failure_node]}
@ -505,7 +509,10 @@ let trans_assertion_failure sil_loc (context: CContext.t) =
let trans_assume_false sil_loc (context: CContext.t) succ_nodes = let trans_assume_false sil_loc (context: CContext.t) succ_nodes =
let if_kind = Sil.Ik_land_lor in let if_kind = Sil.Ik_land_lor in
let instrs_cond = [Sil.Prune (Exp.zero, sil_loc, true, if_kind)] in let instrs_cond = [Sil.Prune (Exp.zero, sil_loc, true, if_kind)] in
let prune_node = Nodes.create_node (Nodes.prune_kind true if_kind) instrs_cond sil_loc context in let prune_node =
Procdesc.create_node context.CContext.procdesc sil_loc (Nodes.prune_kind true if_kind)
instrs_cond
in
Procdesc.node_set_succs_exn context.procdesc prune_node succ_nodes [] ; Procdesc.node_set_succs_exn context.procdesc prune_node succ_nodes [] ;
mk_trans_result (Exp.zero, Typ.(mk (Tint IInt))) mk_trans_result (Exp.zero, Typ.(mk (Tint IInt)))
{empty_control with root_nodes= [prune_node]; leaf_nodes= [prune_node]} {empty_control with root_nodes= [prune_node]; leaf_nodes= [prune_node]}
@ -529,7 +536,7 @@ let trans_std_addressof params_trans_res =
match params_trans_res with [_; fst_arg_res] -> Some fst_arg_res | _ -> assert false match params_trans_res with [_; fst_arg_res] -> Some fst_arg_res | _ -> assert false
let trans_replace_with_deref_first_arg sil_loc params_trans_res ~cxx_method_call = let trans_replace_with_deref_first_arg source_range sil_loc params_trans_res ~cxx_method_call =
let first_arg_res_trans = let first_arg_res_trans =
if cxx_method_call then if cxx_method_call then
match params_trans_res with match params_trans_res with
@ -541,22 +548,24 @@ let trans_replace_with_deref_first_arg sil_loc params_trans_res ~cxx_method_call
else else
match params_trans_res with _ :: fst_arg_res :: _ -> fst_arg_res | [] | [_] -> assert false match params_trans_res with _ :: fst_arg_res :: _ -> fst_arg_res | [] | [_] -> assert false
in in
dereference_value_from_result sil_loc first_arg_res_trans ~strip_pointer:true dereference_value_from_result ~strip_pointer:true source_range sil_loc first_arg_res_trans
let builtin_trans trans_state loc params_trans_res pname = let builtin_trans trans_state source_range loc params_trans_res pname =
if CTrans_models.is_assert_log pname then Some (trans_assertion trans_state loc) if CTrans_models.is_assert_log pname then Some (trans_assertion trans_state loc)
else if CTrans_models.is_builtin_expect pname then trans_builtin_expect params_trans_res else if CTrans_models.is_builtin_expect pname then trans_builtin_expect params_trans_res
else if CTrans_models.is_replace_with_deref_first_arg pname then else if CTrans_models.is_replace_with_deref_first_arg pname then
Some (trans_replace_with_deref_first_arg loc params_trans_res ~cxx_method_call:false) Some
(trans_replace_with_deref_first_arg source_range loc params_trans_res ~cxx_method_call:false)
else if CTrans_models.is_std_addressof pname then trans_std_addressof params_trans_res else if CTrans_models.is_std_addressof pname then trans_std_addressof params_trans_res
else None else None
let cxx_method_builtin_trans trans_state loc params_trans_res pname = let cxx_method_builtin_trans trans_state source_range loc params_trans_res pname =
if CTrans_models.is_assert_log pname then Some (trans_assertion trans_state loc) if CTrans_models.is_assert_log pname then Some (trans_assertion trans_state loc)
else if CTrans_models.is_replace_with_deref_first_arg pname then else if CTrans_models.is_replace_with_deref_first_arg pname then
Some (trans_replace_with_deref_first_arg loc params_trans_res ~cxx_method_call:true) Some
(trans_replace_with_deref_first_arg source_range loc params_trans_res ~cxx_method_call:true)
else None else None
@ -575,8 +584,10 @@ let is_superinstance mei =
let is_null_stmt s = match s with Clang_ast_t.NullStmt _ -> true | _ -> false let is_null_stmt s = match s with Clang_ast_t.NullStmt _ -> true | _ -> false
let extract_stmt_from_singleton stmt_list warning_string = let extract_stmt_from_singleton stmt_list source_range warning_string =
extract_item_from_singleton stmt_list (Pp.to_string ~f:Clang_ast_j.string_of_stmt) warning_string extract_item_from_singleton stmt_list
(Pp.to_string ~f:Clang_ast_j.string_of_stmt)
source_range warning_string
module Self = struct module Self = struct

@ -75,14 +75,17 @@ val mk_cond_continuation : continuation option -> continuation option
val define_condition_side_effects : val define_condition_side_effects :
Exp.t * Typ.t -> Sil.instr list -> Location.t -> (Exp.t * Typ.t) * Sil.instr list Exp.t * Typ.t -> Sil.instr list -> Location.t -> (Exp.t * Typ.t) * Sil.instr list
val extract_stmt_from_singleton : Clang_ast_t.stmt list -> string -> Clang_ast_t.stmt val source_range_of_stmt : Clang_ast_t.stmt -> Clang_ast_t.source_range
val extract_stmt_from_singleton :
Clang_ast_t.stmt list -> Clang_ast_t.source_range -> string -> Clang_ast_t.stmt
val is_null_stmt : Clang_ast_t.stmt -> bool val is_null_stmt : Clang_ast_t.stmt -> bool
val dereference_value_from_result : val dereference_value_from_result :
Location.t -> trans_result -> strip_pointer:bool -> trans_result ?strip_pointer:bool -> Clang_ast_t.source_range -> Location.t -> trans_result -> trans_result
(** Given trans_result with ONE expression, create temporary variable with dereferenced value of an (** Given a [trans_result], create a temporary variable with dereferenced value of an expression
expression assigned to it *) assigned to it *)
val cast_operation : val cast_operation :
Clang_ast_t.cast_kind -> Exp.t * Typ.t -> Typ.t -> Location.t -> Sil.instr list * (Exp.t * Typ.t) Clang_ast_t.cast_kind -> Exp.t * Typ.t -> Typ.t -> Location.t -> Sil.instr list * (Exp.t * Typ.t)
@ -92,10 +95,12 @@ val trans_assertion : trans_state -> Location.t -> trans_result
val contains_opaque_value_expr : Clang_ast_t.stmt -> bool val contains_opaque_value_expr : Clang_ast_t.stmt -> bool
val builtin_trans : val builtin_trans :
trans_state -> Location.t -> trans_result list -> Typ.Procname.t -> trans_result option trans_state -> Clang_ast_t.source_range -> Location.t -> trans_result list -> Typ.Procname.t
-> trans_result option
val cxx_method_builtin_trans : val cxx_method_builtin_trans :
trans_state -> Location.t -> trans_result list -> Typ.Procname.t -> trans_result option trans_state -> Clang_ast_t.source_range -> Location.t -> trans_result list -> Typ.Procname.t
-> trans_result option
val new_or_alloc_trans : val new_or_alloc_trans :
trans_state -> Location.t -> Clang_ast_t.stmt_info -> Clang_ast_t.qual_type -> Typ.Name.t option trans_state -> Location.t -> Clang_ast_t.stmt_info -> Clang_ast_t.qual_type -> Typ.Name.t option
@ -103,16 +108,13 @@ val new_or_alloc_trans :
val cpp_new_trans : Location.t -> Typ.t -> Exp.t option -> (Exp.t * Typ.typ) list -> trans_result val cpp_new_trans : Location.t -> Typ.t -> Exp.t option -> (Exp.t * Typ.typ) list -> trans_result
(** Module for creating cfg nodes and other utility functions related to them. *) (** Module for creating cfg nodes and other utility functions related to them. *)
module Nodes : sig module Nodes : sig
val is_binary_assign_op : Clang_ast_t.binary_operator_info -> bool val is_binary_assign_op : Clang_ast_t.binary_operator_info -> bool
val create_node :
Procdesc.Node.nodekind -> Sil.instr list -> Location.t -> CContext.t -> Procdesc.Node.t
val create_prune_node : val create_prune_node :
branch:bool -> negate_cond:bool -> Exp.t * Typ.t -> Sil.instr list -> Location.t -> Sil.if_kind Procdesc.t -> branch:bool -> negate_cond:bool -> Exp.t -> Sil.instr list -> Location.t
-> CContext.t -> Procdesc.Node.t -> Sil.if_kind -> Procdesc.Node.t
val is_true_prune_node : Procdesc.Node.t -> bool val is_true_prune_node : Procdesc.Node.t -> bool
end end

@ -55,7 +55,7 @@ let get_node_valuation k =
let is_decl_allowed lcxt decl = let is_decl_allowed lcxt decl =
let decl_info = Clang_ast_proj.get_decl_tuple decl in let decl_info = Clang_ast_proj.get_decl_tuple decl in
CLocation.should_do_frontend_check lcxt.CLintersContext.translation_unit_context CLocation.should_do_frontend_check lcxt.CLintersContext.translation_unit_context.source_file
decl_info.Clang_ast_t.di_source_range decl_info.Clang_ast_t.di_source_range

Loading…
Cancel
Save