[erl-frontend] Procnames for Erlang.

Summary: Added Procname for Erlang.

Reviewed By: ngorogiannis

Differential Revision: D28358044

fbshipit-source-id: d233b5be5

infer/src/IR/Procname.ml

@@ -286,7 +286,11 @@ module Parameter = struct
   type clang_parameter = Typ.Name.t option [@@deriving compare, equal, yojson_of]
 
   (** Type for parameters in procnames, for java and clang. *)
-  type t = JavaParameter of Typ.t | ClangParameter of clang_parameter | CSharpParameter of Typ.t
+  type t =
+    | JavaParameter of Typ.t
+    | ClangParameter of clang_parameter
+    | CSharpParameter of Typ.t
+    | ErlangParameter
   [@@deriving compare, equal]
 
   let of_typ typ =
@@ -460,6 +464,20 @@ module C = struct
         false
 end
 
+module Erlang = struct
+  type t = {module_name: string; function_name: string; arity: int} [@@deriving compare, yojson_of]
+
+  let pp verbosity fmt {module_name; function_name; arity} =
+    match verbosity with
+    | Simple | Non_verbose ->
+        F.fprintf fmt "%s/%d" function_name arity
+    | Verbose ->
+        F.fprintf fmt "%s:%s/%d" module_name function_name arity
+
+
+  let set_arity arity name = {name with arity}
+end
+
 module Block = struct
   (** Type of Objective C block names. *)
   type block_type =
@@ -512,6 +530,7 @@ type t =
   | CSharp of CSharp.t
   | Java of Java.t
   | C of C.t
+  | Erlang of Erlang.t
   | Linters_dummy_method
   | Block of Block.t
   | ObjC_Cpp of ObjC_Cpp.t
@@ -545,6 +564,12 @@ let rec compare_name x y =
       -1
   | _, C _ ->
       1
+  | Erlang name1, Erlang name2 ->
+      Erlang.compare name1 name2
+  | Erlang _, _ ->
+      -1
+  | _, Erlang _ ->
+      1
   | Linters_dummy_method, Linters_dummy_method ->
       0
   | Linters_dummy_method, _ ->
@@ -633,7 +658,7 @@ let rec replace_class t (new_class : Typ.Name.t) =
       ObjC_Cpp {osig with class_name= new_class}
   | WithBlockParameters (base, blocks) ->
       WithBlockParameters (replace_class base new_class, blocks)
-  | C _ | Block _ | Linters_dummy_method ->
+  | C _ | Block _ | Erlang _ | Linters_dummy_method ->
       t
 
 
@@ -669,7 +694,7 @@ let rec objc_cpp_replace_method_name t (new_method_name : string) =
       ObjC_Cpp {osig with method_name= new_method_name}
   | WithBlockParameters (base, blocks) ->
       WithBlockParameters (objc_cpp_replace_method_name base new_method_name, blocks)
-  | C _ | Block _ | Linters_dummy_method | Java _ | CSharp _ ->
+  | C _ | CSharp _ | Block _ | Erlang _ | Linters_dummy_method | Java _ ->
       t
 
 
@@ -682,6 +707,8 @@ let rec get_method = function
       get_method base
   | C {name} ->
       QualifiedCppName.to_qual_string name
+  | Erlang name ->
+      name.function_name
   | Block {block_type} ->
       F.asprintf "%a" (Block.pp_block_type ~with_prefix_and_index:false) block_type
   | Java j ->
@@ -709,6 +736,8 @@ let get_language = function
       Language.Clang
   | C _ ->
       Language.Clang
+  | Erlang _ ->
+      Language.Erlang
   | Block _ ->
       Language.Clang
   | Linters_dummy_method ->
@@ -772,6 +801,8 @@ let rec pp_unique_id fmt = function
       CSharp.pp Verbose fmt cs
   | C osig ->
       C.pp Verbose fmt osig
+  | Erlang e ->
+      Erlang.pp Verbose fmt e
   | ObjC_Cpp osig ->
       ObjC_Cpp.pp Verbose fmt osig
   | Block bsig ->
@@ -794,6 +825,8 @@ let rec pp fmt = function
       CSharp.pp Non_verbose fmt cs
   | C osig ->
       C.pp Non_verbose fmt osig
+  | Erlang e ->
+      Erlang.pp Non_verbose fmt e
   | ObjC_Cpp osig ->
       ObjC_Cpp.pp Non_verbose fmt osig
   | Block bsig ->
@@ -824,6 +857,8 @@ let rec pp_simplified_string ?(withclass = false) fmt = function
       CSharp.pp ~withclass Simple fmt cs
   | C osig ->
       C.pp Simple fmt osig
+  | Erlang e ->
+      Erlang.pp Simple fmt e
   | ObjC_Cpp osig ->
       ObjC_Cpp.pp (if withclass then Non_verbose else Simple) fmt osig
   | Block bsig ->
@@ -887,6 +922,8 @@ let rec get_parameters procname =
       List.map ~f:(fun par -> Parameter.CSharpParameter par) (CSharp.get_parameters cs)
   | C osig ->
       clang_param_to_param (C.get_parameters osig)
+  | Erlang e ->
+      List.init e.arity ~f:(fun _ -> Parameter.ErlangParameter)
   | ObjC_Cpp osig ->
       clang_param_to_param (ObjC_Cpp.get_parameters osig)
   | Block bsig ->
@@ -933,6 +970,17 @@ let rec replace_parameters new_parameters procname =
               params )
       params
   in
+  let params_to_erlang_arity params =
+    let check = function
+      | Parameter.ErlangParameter ->
+          ()
+      | _ ->
+          L.die InternalError
+            "Expected Erlang parameters in Erlang procname, but got parameters of another language"
+    in
+    List.iter ~f:check params ;
+    List.length params
+  in
   match procname with
   | Java j ->
       Java (Java.replace_parameters (params_to_java_params new_parameters) j)
@@ -940,6 +988,8 @@ let rec replace_parameters new_parameters procname =
       CSharp (CSharp.replace_parameters (params_to_csharp_params new_parameters) cs)
   | C osig ->
       C (C.replace_parameters (params_to_clang_params new_parameters) osig)
+  | Erlang e ->
+      Erlang (Erlang.set_arity (params_to_erlang_arity new_parameters) e)
   | ObjC_Cpp osig ->
       ObjC_Cpp (ObjC_Cpp.replace_parameters (params_to_clang_params new_parameters) osig)
   | Block bsig ->

infer/src/IR/Procname.mli

@@ -129,7 +129,11 @@ module Parameter : sig
   type clang_parameter = Typ.Name.t option [@@deriving compare, equal]
 
   (** Type for parameters in procnames, for java and clang. *)
-  type t = JavaParameter of Typ.t | ClangParameter of clang_parameter | CSharpParameter of Typ.t
+  type t =
+    | JavaParameter of Typ.t
+    | ClangParameter of clang_parameter
+    | CSharpParameter of Typ.t
+    | ErlangParameter
   [@@deriving compare, equal]
 
   val of_typ : Typ.t -> clang_parameter
@@ -209,6 +213,10 @@ module Block : sig
   val make_in_outer_scope : block_type -> int -> Parameter.clang_parameter list -> t
 end
 
+module Erlang : sig
+  type t
+end
+
 (** Type of procedure names. WithBlockParameters is used for creating an instantiation of a method
     that contains block parameters and it's called with concrete blocks. For example:
     [foo(Block block) {block();}] [bar() {foo(my_block)}] is executed as
@@ -218,6 +226,7 @@ type t =
   | CSharp of CSharp.t
   | Java of Java.t
   | C of C.t
+  | Erlang of Erlang.t
   | Linters_dummy_method
   | Block of Block.t
   | ObjC_Cpp of ObjC_Cpp.t

infer/src/absint/ConcurrencyModels.ml

@@ -331,7 +331,8 @@ let is_android_lifecycle_method tenv pname =
         false
   in
   match (pname : Procname.t) with
-  | C _ | Linters_dummy_method | Block _ | ObjC_Cpp _ | CSharp _ | WithBlockParameters _ ->
+  | C _ | Erlang _ | Linters_dummy_method | Block _ | ObjC_Cpp _ | CSharp _ | WithBlockParameters _
+    ->
       false
   | Java _ ->
       method_starts_with_on pname

infer/src/base/Checker.ml

@@ -68,10 +68,26 @@ let config_unsafe checker =
   let supports_clang_and_java _ = Support in
   let supports_clang_and_java_experimental _ = ExperimentalSupport in
   let supports_clang (language : Language.t) =
-    match language with Clang -> Support | Java -> NoSupport | CIL -> NoSupport
+    match language with
+    | Clang ->
+        Support
+    | Java ->
+        NoSupport
+    | CIL ->
+        NoSupport
+    | Erlang ->
+        NoSupport
   in
   let supports_java (language : Language.t) =
-    match language with Clang -> NoSupport | Java -> Support | CIL -> Support
+    match language with
+    | Clang ->
+        NoSupport
+    | Java ->
+        Support
+    | CIL ->
+        Support
+    | Erlang ->
+        NoSupport
   in
   match checker with
   | AnnotationReachability ->
@@ -306,7 +322,7 @@ let config_unsafe checker =
       { id= "pulse"
       ; kind=
           UserFacing {title= "Pulse"; markdown_body= [%blob "../../documentation/checkers/Pulse.md"]}
-      ; support= (function Clang | Java -> Support | CIL -> NoSupport)
+      ; support= (function Clang | Java -> Support | CIL -> NoSupport | Erlang -> Support)
       ; short_documentation= "Memory and lifetime analysis."
       ; cli_flags= Some {deprecated= ["-ownership"]; show_in_help= true}
       ; enabled_by_default= false
@@ -363,7 +379,8 @@ let config_unsafe checker =
                  leaks! See the [lab \
                  instructions](https://github.com/facebook/infer/blob/master/infer/src/labs/README.md)."
             }
-      ; support= (function Clang -> NoSupport | Java -> Support | CIL -> Support)
+      ; support=
+          (function Clang -> NoSupport | Java -> Support | CIL -> Support | Erlang -> NoSupport)
       ; short_documentation=
           "Toy checker for the \"resource leak\" write-your-own-checker exercise."
       ; cli_flags= Some {deprecated= []; show_in_help= false}
@@ -372,7 +389,8 @@ let config_unsafe checker =
   | DOTNETResourceLeaks ->
       { id= "dotnet-resource-leak"
       ; kind= UserFacing {title= "Resource Leak checker for .NET"; markdown_body= ""}
-      ; support= (function Clang -> NoSupport | Java -> NoSupport | CIL -> Support)
+      ; support=
+          (function Clang -> NoSupport | Java -> NoSupport | CIL -> Support | Erlang -> NoSupport)
       ; short_documentation= "\"resource leak\" checker for .NET."
       ; cli_flags= Some {deprecated= []; show_in_help= false}
       ; enabled_by_default= true

infer/src/base/Language.ml

@@ -6,11 +6,13 @@
  *)
 open! IStd
 
-type t = Clang | Java | CIL [@@deriving compare, enumerate]
+type t = Clang | CIL | Erlang | Java [@@deriving compare, enumerate]
 
 let equal = [%compare.equal: t]
 
-let language_to_string = [(Clang, "C/C++/ObjC"); (Java, "Java"); (CIL, "C#/.Net")]
+let language_to_string =
+  [(Clang, "C/C++/ObjC"); (Erlang, "Erlang"); (Java, "Java"); (CIL, "C#/.Net")]
+
 
 let to_string lang = List.Assoc.find_exn language_to_string ~equal lang
 

infer/src/base/Language.mli

@@ -7,7 +7,7 @@
 
 open! IStd
 
-type t = Clang | Java | CIL [@@deriving compare, enumerate]
+type t = Clang | CIL | Erlang | Java [@@deriving compare, enumerate]
 
 val equal : t -> t -> bool
 

infer/src/biabduction/Prover.ml

@@ -2235,6 +2235,8 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : subst2 *
             ["System.String.Empty" (* ; "System.String.Chars" *); "System.String.Length"]
           in
           Predicates.Estruct (List.map ~f:mk_fld_sexp fields, Predicates.inst_none)
+      | Erlang ->
+          L.die InternalError "Erlang not supported"
     in
     let const_string_texp =
       match !Language.curr_language with
@@ -2260,6 +2262,8 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : subst2 *
             ; nbytes= None
             ; dynamic_length= None
             ; subtype= Subtype.exact }
+      | Erlang ->
+          L.die InternalError "Erlang not supported"
     in
     Predicates.Hpointsto (root, sexp, const_string_texp)
   in

infer/src/biabduction/Rearrange.ml

@@ -477,6 +477,8 @@ let mk_ptsto_exp_footprint analysis_data pname tenv orig_prop (lexp, typ) max_st
         Subtype.subtypes
     | CIL ->
         Subtype.subtypes
+    | Erlang ->
+        L.die InternalError "Erlang not supported"
   in
   let create_ptsto footprint_part off0 =
     match (root, off0, typ.Typ.desc) with

infer/src/biabduction/interproc.ml

@@ -628,6 +628,8 @@ let prop_init_formals_seed tenv new_formals (prop : 'a Prop.t) : Prop.exposed Pr
             Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.exact}
         | Java | CIL ->
             Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.subtypes}
+        | Erlang ->
+            L.die InternalError "Erlang not supported"
       in
       Prop.mk_ptsto_lvar tenv Prop.Fld_init Predicates.inst_formal (pv, texp, None)
     in

infer/src/bufferoverrun/bufferOverrunUtils.ml

@@ -89,6 +89,8 @@ module Exec = struct
         | Language.CIL ->
             (* cil todo *)
             Dom.Val.of_java_array_alloc allocsite ~length:size ~traces
+        | Language.Erlang ->
+            L.die InternalError "Erlang not supported"
       in
       if Int.equal dimension 1 then Dom.Mem.add_stack ~represents_multiple_values loc arr mem
       else Dom.Mem.add_heap ~represents_multiple_values loc arr mem

infer/src/concurrency/AbstractAddress.ml

@@ -53,12 +53,24 @@ let normalise_access_list (accesses : access_list) =
 let pp_with_base pp_base fmt (base, accesses) =
   let rec pp_rev_accesses fmt (accesses : access_list) =
     match (accesses, !Language.curr_language) with
+    | _, Erlang ->
+        L.internal_error "Erlang not supported"
     | [], _ ->
         pp_base fmt base
     | ArrayAccess _ :: rest, _ ->
         F.fprintf fmt "%a[]" pp_rev_accesses rest
     | FieldAccess field_name :: Dereference :: rest, _ ->
-        let op = match !Language.curr_language with Clang -> "->" | Java -> "." | CIL -> "." in
+        let op =
+          match !Language.curr_language with
+          | Clang ->
+              "->"
+          | Java ->
+              "."
+          | CIL ->
+              "."
+          | Erlang ->
+              L.die InternalError "Erlang not supported"
+        in
         F.fprintf fmt "%a%s%a" pp_rev_accesses rest op Fieldname.pp field_name
     | FieldAccess field_name :: rest, _ ->
         (* Java is allowed here only because the frontend is broken and generates

infer/src/concurrency/RacerDDomain.ml

@@ -35,6 +35,8 @@ let pp_exp fmt exp =
       AccessPath.pp fmt (AccessExpression.to_access_path exp)
   | CIL ->
       AccessPath.pp fmt (AccessExpression.to_access_path exp)
+  | Erlang ->
+      L.die InternalError "Erlang not supported"
 
 
 let rec should_keep_exp formals (exp : AccessExpression.t) =

infer/src/concurrency/StarvationModels.ml

@@ -406,7 +406,8 @@ let is_java_main_method (pname : Procname.t) =
     match args with [arg] -> Typ.equal pointer_to_array_of_java_lang_string arg | _ -> false
   in
   match pname with
-  | C _ | Linters_dummy_method | Block _ | ObjC_Cpp _ | CSharp _ | WithBlockParameters _ ->
+  | C _ | Erlang _ | Linters_dummy_method | Block _ | ObjC_Cpp _ | CSharp _ | WithBlockParameters _
+    ->
       false
   | Java java_pname ->
       Procname.Java.is_static java_pname

infer/tests/codetoanalyze/objc/frontend/block/retain_cycle.m.dot

@@ -71,7 +71,7 @@ digraph cfg {
 "dealloc#A#instance.55ac864e91dcd5d484e8ab7d8eb94fcb_2" [label="2: Exit A.dealloc \n  " color=yellow style=filled]
 	
 
-"dealloc#A#instance.55ac864e91dcd5d484e8ab7d8eb94fcb_3" [label="3:  Call dealloc \n   n$0=*&self:A* [line 50, column 1]\n  n$1=*n$0._data:D* [line 50, column 1]\n  n$2=_fun_D.dealloc(n$1:D*) [line 50, column 1]\n  n$3=*&self:A* [line 50, column 1]\n  n$4=*n$3._b:B* [line 50, column 1]\n  n$5=_fun_B.dealloc(n$4:B*) [line 50, column 1]\n " shape="box"]
+"dealloc#A#instance.55ac864e91dcd5d484e8ab7d8eb94fcb_3" [label="3:  Call dealloc \n   n$3=*&self:A* [line 50, column 1]\n  n$4=*n$3._data:D* [line 50, column 1]\n  n$5=_fun_D.dealloc(n$4:D*) [line 50, column 1]\n  n$6=*&self:A* [line 50, column 1]\n  n$7=*n$6._b:B* [line 50, column 1]\n  n$8=_fun_B.dealloc(n$7:B*) [line 50, column 1]\n " shape="box"]
 	
 
 	 "dealloc#A#instance.55ac864e91dcd5d484e8ab7d8eb94fcb_3" -> "dealloc#A#instance.55ac864e91dcd5d484e8ab7d8eb94fcb_2" ;
@@ -82,7 +82,7 @@ digraph cfg {
 "dealloc#B#instance.8757740e0d47129962d40fbccbdf4d3f_2" [label="2: Exit B.dealloc \n  " color=yellow style=filled]
 	
 
-"dealloc#B#instance.8757740e0d47129962d40fbccbdf4d3f_3" [label="3:  Call dealloc \n   n$6=*&self:B* [line 31, column 1]\n  n$7=*n$6._d:D* [line 31, column 1]\n  n$8=_fun_D.dealloc(n$7:D*) [line 31, column 1]\n " shape="box"]
+"dealloc#B#instance.8757740e0d47129962d40fbccbdf4d3f_3" [label="3:  Call dealloc \n   n$0=*&self:B* [line 31, column 1]\n  n$1=*n$0._d:D* [line 31, column 1]\n  n$2=_fun_D.dealloc(n$1:D*) [line 31, column 1]\n " shape="box"]
 	
 
 	 "dealloc#B#instance.8757740e0d47129962d40fbccbdf4d3f_3" -> "dealloc#B#instance.8757740e0d47129962d40fbccbdf4d3f_2" ;