infer_clone/infer/src/clang/cFrontend_checkers.ml

(*
 * Copyright (c) 2015 - present Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD style license found in the
 * LICENSE file in the root directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *)

open! IStd
module L = Logging

(* Helper functions *)
let location_from_stmt lctx stmt =
  let info, _ = Clang_ast_proj.get_stmt_tuple stmt in
  CLocation.get_sil_location_from_range lctx.CLintersContext.translation_unit_context
    info.Clang_ast_t.si_source_range true

let location_from_dinfo lctx info =
  CLocation.get_sil_location_from_range lctx.CLintersContext.translation_unit_context
    info.Clang_ast_t.di_source_range true

let location_from_decl lctx dec =
  let info = Clang_ast_proj.get_decl_tuple dec in
  CLocation.get_sil_location_from_range lctx.CLintersContext.translation_unit_context
    info.Clang_ast_t.di_source_range true

let location_from_an lcxt an =
  match an with
  | Ctl_parser_types.Stmt st
   -> location_from_stmt lcxt st
  | Ctl_parser_types.Decl d
   -> location_from_decl lcxt d

let tag_name_of_node an =
  match an with
  | Ctl_parser_types.Stmt stmt
   -> Clang_ast_proj.get_stmt_kind_string stmt
  | Ctl_parser_types.Decl decl
   -> Clang_ast_proj.get_decl_kind_string decl

let decl_ref_or_selector_name an =
  match CTL.next_state_via_transition an CTL.PointerToDecl with
  | [(Ctl_parser_types.Decl ObjCMethodDecl _ as decl_an)]
   -> "The selector " ^ Ctl_parser_types.ast_node_name decl_an
  | [(Ctl_parser_types.Decl _ as decl_an)]
   -> "The reference " ^ Ctl_parser_types.ast_node_name decl_an
  | _
   -> L.(die ExternalError)
        "decl_ref_or_selector_name must be called with a DeclRefExpr or an ObjCMessageExpr, but got %s"
        (tag_name_of_node an)

let iphoneos_target_sdk_version context _ =
  match CPredicates.iphoneos_target_sdk_version_by_path context with Some f -> f | None -> "0"

let available_ios_sdk an =
  let open Ctl_parser_types in
  match CTL.next_state_via_transition an CTL.PointerToDecl with
  | [(Decl decl)] -> (
    match CPredicates.get_available_attr_ios_sdk (Decl decl) with
    | Some version
     -> version
    | None
     -> "" )
  | _
   -> L.(die ExternalError)
        "available_ios_sdk must be called with a DeclRefExpr or an ObjCMessageExpr, but got %s"
        (tag_name_of_node an)

let class_available_ios_sdk an =
  match CPredicates.receiver_method_call an with
  | Some decl -> (
    match CPredicates.get_available_attr_ios_sdk (Decl decl) with
    | Some version
     -> version
    | None
     -> "" )
  | None
   -> L.(die ExternalError)
        "class_available_ios_sdk must be called with ObjCMessageExpr, but got %s"
        (tag_name_of_node an)

let receiver_method_call an =
  match CPredicates.receiver_method_call an with
  | Some decl
   -> Ctl_parser_types.ast_node_name (Ctl_parser_types.Decl decl)
  | _
   -> L.(die ExternalError)
        "receiver_method_call must be called with ObjCMessageExpr, but got %s"
        (tag_name_of_node an)

let ivar_name an =
  let open Clang_ast_t in
  match an with
  | Ctl_parser_types.Stmt ObjCIvarRefExpr (_, _, _, rei)
   -> (
      let dr_ref = rei.ovrei_decl_ref in
      let ivar_pointer = dr_ref.dr_decl_pointer in
      match CAst_utils.get_decl ivar_pointer with
      | Some ObjCIvarDecl (_, named_decl_info, _, _, _)
       -> named_decl_info.Clang_ast_t.ni_name
      | _
       -> "" )
  | _
   -> ""

let cxx_ref_captured_in_block an =
  let open Ctl_parser_types in
  let open Clang_ast_t in
  let capt_refs =
    match an with
    | Decl _
     -> CPredicates.captured_variables_cxx_ref an
    | Stmt BlockExpr (_, _, _, d)
     -> CPredicates.captured_variables_cxx_ref (Decl d)
    | _
     -> []
  in
  let var_desc vars var_named_decl_info = vars ^ "'" ^ var_named_decl_info.ni_name ^ "'" in
  List.fold ~f:var_desc ~init:"" capt_refs

let class_name node =
  let open Clang_ast_t in
  let class_name_of_interface_type typ =
    match typ with
    | Some ObjCInterfaceType (_, ptr) -> (
      match CAst_utils.get_decl ptr with
      | Some ObjCInterfaceDecl (_, ndi, _, _, _)
       -> ndi.ni_name
      | _
       -> "" )
    | _
     -> ""
  in
  match CPredicates.get_ast_node_type_ptr node with
  | Some type_ptr
   -> (
      let typ = CAst_utils.get_desugared_type type_ptr in
      match typ with
      | Some ObjCObjectPointerType (_, {Clang_ast_t.qt_type_ptr})
       -> class_name_of_interface_type (CAst_utils.get_desugared_type qt_type_ptr)
      | Some ObjCInterfaceType _
       -> class_name_of_interface_type typ
      | _
       -> "" )
  | _
   -> ""