Add Cilfacade.mkCast to fix base invariant crashes

Author: sim642

.semgrep/cil.yml

@@ -5,6 +5,7 @@ rules:
       - pattern: Cil.typeOfLval
       - pattern: Cil.typeOfInit
       - pattern: Cil.typeOffset
+      - pattern: Cil.mkCast
       - pattern: Cil.get_stmtLoc
     paths:
       exclude:

src/analyses/base.ml

@@ -511,7 +511,7 @@ struct
       let toInt i =
         match IdxDom.to_int @@ ID.cast_to ik i with
         | Some x -> Const (CInt (x,ik, None))
-        | _ -> mkCast ~e:(Const (CStr ("unknown",No_encoding))) ~newt:intType
+        | _ -> Cilfacade.mkCast ~e:(Const (CStr ("unknown",No_encoding))) ~newt:intType
 
       in
       match o with

src/cdomains/apron/apronDomain.apron.ml

@@ -368,7 +368,7 @@ struct
       match V.to_cil_varinfo fundec v with
       | Some vinfo ->
         (* TODO: What to do with variables that have a type that cannot be stored into ILongLong to avoid overflows? *)
-        let var = Cil.mkCast ~e:(Lval(Var vinfo,NoOffset)) ~newt:longlong in
+        let var = Cilfacade.mkCast ~e:(Lval(Var vinfo,NoOffset)) ~newt:longlong in
         let coeff, flip = coeff_to_const true c in
         let prod = BinOp(Mult, coeff, var, longlong) in
         if flip then

src/cdomains/intDomain.ml

@@ -319,7 +319,7 @@ struct
   let name () = "IntDomLifter(" ^ (I.name ()) ^ ")"
   let to_yojson x = I.to_yojson x.v
   let invariant e x =
-    let e' = Cil.(mkCast ~e ~newt:(TInt (x.ikind, []))) in
+    let e' = Cilfacade.mkCast ~e ~newt:(TInt (x.ikind, [])) in
     I.invariant_ikind e' x.ikind x.v
   let tag x = I.tag x.v
   let arbitrary ik = failwith @@ "Arbitrary not implement for " ^ (name ()) ^ "."

src/util/cilfacade.ml

@@ -442,6 +442,16 @@ and typeOffset basetyp =
     | _ -> raise (TypeOfError Field_NonCompound)
 
 
+(** {!Cil.mkCast} using our {!typeOf}. *)
+let mkCast ~(e: exp) ~(newt: typ) =
+  let oldt =
+    try
+      typeOf e
+    with TypeOfError _ -> (* e might involve alloc variables, weird offsets, etc *)
+      Cil.voidType (* oldt is only used for avoiding duplicate cast, so this falls back to adding cast *)
+  in
+  Cil.mkCastT ~e ~oldt ~newt
+
 let get_ikind_exp e = get_ikind (typeOf e)