Merge pull request #593 from goblint/remove-catch-all

Fix most catch-alls

Author: sim642

src/analyses/base.ml

@@ -346,7 +346,7 @@ struct
    *  which part of an array is involved.  *)
   let rec get ?(full=false) a (gs: glob_fun) (st: store) (addrs:address) (exp:exp option): value =
     let at = AD.get_type addrs in
-    let firstvar = if M.tracing then try (List.hd (AD.to_var_may addrs)).vname with _ -> "" else "" in
+    let firstvar = if M.tracing then match AD.to_var_may addrs with [] -> "" | x :: _ -> x.vname else "" in
     if M.tracing then M.traceli "get" ~var:firstvar "Address: %a\nState: %a\n" AD.pretty addrs CPA.pretty st.cpa;
     (* Finding a single varinfo*offset pair *)
     let res =
@@ -929,7 +929,7 @@ struct
         | `Address a ->
           let slen = List.map String.length (AD.to_string a) in
           let lenOf = function
-            | TArray (_, l, _) -> (try Some (lenOfArray l) with _ -> None)
+            | TArray (_, l, _) -> (try Some (lenOfArray l) with LenOfArray -> None)
             | _ -> None
           in
           let alen = List.filter_map (fun v -> lenOf v.vtype) (AD.to_var_may a) in
@@ -1107,7 +1107,7 @@ struct
       if M.tracing then M.tracel "setosek" ~var:x.vname "update_variable: start '%s' '%a'\nto\n%a\nresults in\n%a\n" x.vname VD.pretty y CPA.pretty z CPA.pretty r;
       r
     in
-    let firstvar = if M.tracing then try (List.hd (AD.to_var_may lval)).vname with _ -> "" else "" in
+    let firstvar = if M.tracing then match AD.to_var_may lval with [] -> "" | x :: _ -> x.vname else "" in
     let lval_raw = (Option.map (fun x -> Lval x) lval_raw) in
     if M.tracing then M.tracel "set" ~var:firstvar "lval: %a\nvalue: %a\nstate: %a\n" AD.pretty lval VD.pretty value CPA.pretty st.cpa;
     (* Updating a single varinfo*offset pair. NB! This function's type does
@@ -1512,7 +1512,9 @@ struct
          * If the upper bound of a is divisible by b, we can also meet with the result of a/b*b - c to get the precise [3,3].
          * If b is negative we have to look at the lower bound. *)
         let is_divisible bound =
-          try ID.rem (bound a |> Option.get |> ID.of_int ikind) b |> ID.to_int = Some BI.zero with _ -> false
+          match bound a with
+          | Some ba -> ID.rem (ID.of_int ikind ba) b |> ID.to_int = Some BI.zero
+          | None -> false
         in
         let max_pos = match ID.maximal b with None -> true | Some x -> BI.compare x BI.zero >= 0 in
         let min_neg = match ID.minimal b with None -> true | Some x -> BI.compare x BI.zero < 0 in

src/analyses/extract_arinc.ml

@@ -278,7 +278,7 @@ struct
         (* evaluates an argument and returns a list of possible values for that argument. *)
         let eval = function
           | Pml.EvalSkip -> const None
-          | Pml.EvalInt -> fun e -> Some (try eval_int e with _ -> eval_id e)
+          | Pml.EvalInt -> fun e -> Some (try eval_int e with Failure _ -> eval_id e)
           | Pml.EvalString -> fun e -> Some (List.map (fun x -> "\""^x^"\"") (eval_str e))
           | Pml.EvalEnum f -> fun e -> Some (List.map (fun x -> Option.get (f (int_of_string x))) (eval_int e))
           | Pml.AssignIdOfString (res, pos) -> fun e ->

src/analyses/extract_osek.ml

@@ -271,7 +271,7 @@ struct
         (* evaluates an argument and returns a list of possible values for that argument. *)
         let eval = function
           | Pml.EvalSkip -> const None
-          | Pml.EvalInt -> fun e -> Some (try eval_int e with _ -> eval_id e)
+          | Pml.EvalInt -> fun e -> Some (try eval_int e with Failure _ -> eval_id e)
           | Pml.EvalString -> fun e -> Some (List.map (fun x -> "\""^x^"\"") (eval_str e))
           | Pml.EvalEnum f -> fun e -> Some (List.map (fun x -> Option.get (f (int_of_string x))) (eval_int e))
           | Pml.AssignIdOfString (res, pos) -> fun e ->

src/analyses/flag.ml

@@ -122,7 +122,7 @@ struct
 
   let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t =
     let _ = List.iter no_addr_of_flag arglist in
-    match f.vname with _ -> D.top ()
+    D.top ()
 
   let startstate v = D.top ()
   let threadenter ctx lval f args = [D.top ()]

src/analyses/osek.ml

@@ -441,11 +441,11 @@ struct
       if not (is_task v.vname) || flagstate = Flags.top() then begin
         if !GU.should_warn then begin
           let new_acc = ((loc,fl,rv),ust,o) in
-          let curr : AccValSet.t = try Acc.find acc v with _ -> AccValSet.empty in
+          let curr : AccValSet.t = Acc.find_default acc v AccValSet.empty in
           let neww : AccValSet.t = AccValSet.add (new_acc,flagstate) (remove_acc new_acc curr) in
           Acc.replace acc v neww;
           accKeys := AccKeySet.add v !accKeys;
-          let curr = try Hashtbl.find off_pry_with_flag v.vname with _ -> [] in
+          let curr = Hashtbl.find_default off_pry_with_flag v.vname [] in
           let pry = offpry [new_acc] in
           Hashtbl.replace off_pry_with_flag v.vname ((flagstate,pry)::curr)
         end ;
@@ -584,7 +584,7 @@ struct
     | Queries.Priority "" ->
       let pry = resourceset_to_priority (List.map names (Mutex.Lockset.ReverseAddrSet.elements ctx.local)) in
       Queries.ID.of_int IInt @@ IntOps.BigIntOps.of_int pry (* TODO: what ikind to use for priorities? *)
-    | Queries.Priority vname -> begin try Queries.ID.of_int IInt @@ IntOps.BigIntOps.of_int (Hashtbl.find offensivepriorities vname) with _ -> Queries.Result.top q end (* TODO: what ikind to use for priorities? *)
+    | Queries.Priority vname -> begin try Queries.ID.of_int IInt @@ IntOps.BigIntOps.of_int (Hashtbl.find offensivepriorities vname) with Not_found -> Queries.Result.top q end (* TODO: what ikind to use for priorities? *)
     | Queries.MayBePublic {global=v; _} ->
       let pry = resourceset_to_priority (List.map names (Mutex.Lockset.ReverseAddrSet.elements ctx.local)) in
       if pry = min_int then

src/cdomains/intDomain.ml

@@ -218,7 +218,7 @@ struct
   let equal_to (x: int_t) (a: t)=
     try
       Old.equal_to (BI.to_int64 x) a
-    with e -> `Top
+    with Z.Overflow | Failure _ -> `Top
 
   let to_excl_list a = Option.map (List.map BI.of_int64) (Old.to_excl_list a)
   let of_excl_list ik xs =
@@ -393,7 +393,7 @@ module Size = struct (* size in bits as int, range as int64 *)
   let bit = function (* bits needed for representation *)
     | IBool -> 1
     | ik -> bytesSizeOfInt ik * 8
-  let is_int64_big_int x = try let _ = int64_of_big_int x in true with _ -> false
+  let is_int64_big_int x = Z.fits_int64 x
   let card ik = (* cardinality *)
     let b = bit ik in
     shift_left_big_int unit_big_int b
@@ -822,12 +822,9 @@ struct
     | Some (x1, x2) ->
       let open Invariant in
       let (x1', x2') = BatTuple.Tuple2.mapn (Ints_t.to_bigint) (x1, x2) in
-      (try
-        (* Cilfacade.typeOf will fail if c is heap allocated *)
-        let i1 = if Ints_t.compare (min_int ik) x1 <> 0 then of_exp Cil.(BinOp (Le, kintegerCilint ik x1', c, intType)) else none in
-        let i2 = if Ints_t.compare x2 (max_int ik) <> 0 then of_exp Cil.(BinOp (Le, c, kintegerCilint ik x2', intType)) else none in
-        i1 && i2
-      with e -> None)
+      let i1 = if Ints_t.compare (min_int ik) x1 <> 0 then of_exp Cil.(BinOp (Le, kintegerCilint ik x1', c, intType)) else none in
+      let i2 = if Ints_t.compare x2 (max_int ik) <> 0 then of_exp Cil.(BinOp (Le, c, kintegerCilint ik x2', intType)) else none in
+      i1 && i2
     | None -> None
 
   let arbitrary ik =
@@ -2443,11 +2440,9 @@ struct
       let c = Ints_t.to_bigint c in
       Invariant.of_exp Cil.(BinOp (Eq, l, Cil.kintegerCilint ik c, intType))
     | Some (c, m) ->
-       let open Cil in
-       let (c, m) = BatTuple.Tuple2.mapn (fun a -> kintegerCilint ik @@ Ints_t.to_bigint a) (c, m) in
-       (try
-          Invariant.of_exp (BinOp (Eq, (BinOp (Mod, l, m, TInt(ik,[]))), c, intType))
-        with e -> None)
+      let open Cil in
+      let (c, m) = BatTuple.Tuple2.mapn (fun a -> kintegerCilint ik @@ Ints_t.to_bigint a) (c, m) in
+      Invariant.of_exp (BinOp (Eq, (BinOp (Mod, l, m, TInt(ik,[]))), c, intType))
     | None -> None
 
   let arbitrary ik =
@@ -2656,7 +2651,7 @@ module IntDomTupleImpl = struct
     mapp2 { fp2 = fun (type a) (module I:S with type t = a and type int_t = int_t) -> I.to_incl_list } x |> flat merge
 
 
-  let pretty () = (fun xs -> text "(" ++ (try List.reduce (fun a b -> a ++ text "," ++ b) xs with _ -> nil) ++ text ")") % to_list % mapp { fp = fun (type a) (module I:S with type t = a) -> (* assert sf==I.short; *) I.pretty () } (* NOTE: the version above does something else. also, we ignore the sf-argument here. *)
+  let pretty () = (fun xs -> text "(" ++ (try List.reduce (fun a b -> a ++ text "," ++ b) xs with Invalid_argument _ -> nil) ++ text ")") % to_list % mapp { fp = fun (type a) (module I:S with type t = a) -> (* assert sf==I.short; *) I.pretty () } (* NOTE: the version above does something else. also, we ignore the sf-argument here. *)
 
 
   let refine_functions ik : (t -> t) list =

src/cdomains/lval.ml

@@ -21,7 +21,9 @@ struct
   type t = (fieldinfo, Idx.t) offs
   include Printable.Std
 
-  let is_first_field x = try CilType.Fieldinfo.equal (List.hd x.fcomp.cfields) x with _ -> false
+  let is_first_field x = match x.fcomp.cfields with
+    | [] -> false
+    | f :: _ -> CilType.Fieldinfo.equal f x
 
   let rec cmp_zero_offset : t -> [`MustZero | `MustNonzero | `MayZero] = function
     | `NoOffset -> `MustZero

src/cdomains/valueDomain.ml

@@ -394,16 +394,17 @@ struct
               | _ -> log_top __POS__; AD.top_ptr
             )
         | TArray (ta, l, _) -> (* TODO, why is the length exp option? *)
-          `Array (match v, Prelude.try_opt Cil.lenOfArray l with
-              | `Array x, _ (* Some l' when Some l' = CArrays.length x *) -> x (* TODO handle casts between different sizes? *)
+          (* TODO handle casts between different sizes? *)
+          `Array (match v with
+              | `Array x -> x
               | _ -> log_top __POS__; CArrays.top ()
             )
         | TComp (ci,_) -> (* struct/union *)
           (* rather clumsy, but our abstract values don't keep their type *)
           let same_struct x = (* check if both have the same parent *)
-            (* compinfo is cyclic, so we only check the name *)
-            try compFullName (List.hd (Structs.keys x)).fcomp = compFullName (List.hd ci.cfields).fcomp
-            with _ -> false (* can't say if struct is empty *)
+            match Structs.keys x, ci.cfields with
+            | k :: _, f :: _ -> compFullName k.fcomp = compFullName f.fcomp (* compinfo is cyclic, so we only check the name *)
+            | _, _ -> false (* can't say if struct is empty *)
           in
           (* 1. casting between structs of different type does not work
            * 2. dereferencing a casted pointer works, but is undefined behavior because of the strict aliasing rule (compiler assumes that pointers of different type can never point to the same location)

src/domains/access.ml

@@ -154,13 +154,14 @@ type var_o = varinfo option
 type off_o = offset  option
 
 let get_val_type e (vo: var_o) (oo: off_o) : acc_typ =
-  try (* FIXME: Cilfacade.typeOf fails on our fake variables: (struct s).data *)
-    let t = Cilfacade.typeOf e in
-    match vo, oo with
-    | Some v, Some o -> get_type t (AddrOf (Var v, o))
-    | Some v, None -> get_type t (AddrOf (Var v, NoOffset))
-    | _ -> get_type t e
-  with _ -> get_type voidType e
+  match Cilfacade.typeOf e with
+  | t ->
+    begin match vo, oo with
+      | Some v, Some o -> get_type t (AddrOf (Var v, o))
+      | Some v, None -> get_type t (AddrOf (Var v, NoOffset))
+      | _ -> get_type t e
+    end
+  | exception (Cilfacade.TypeOfError _) -> get_type voidType e
 
 let add_one side (e:exp) (w:bool) (conf:int) (ty:acc_typ) (lv:(varinfo*offs) option) a: unit =
   if is_ignorable lv then () else begin

src/prelude.ml

@@ -5,7 +5,6 @@ module All = struct
   let comp2 f g a b = f (g a) (g b)
   let compareBy ?cmp:(cmp=compare) f = comp2 cmp f
   let str_remove m s = String.nreplace ~str:s ~sub:m ~by:""
-  let try_opt f a = try Some (f a) with _ -> None (* reason: match .. with _ does not include exceptions, or-patterns currently not supported for exceptions *)
 
   (* Sys.time gives runtime in seconds as float *)
   let split_time () = (* gives CPU time in h,m,s,ms *)