From c6d19a977d7671354b4daf7bb870b295d69091b0 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 15 May 2024 12:30:01 +0200 Subject: [PATCH 001/107] initial components for coefficients added --- .../apron/linearTwoVarEqualityDomain.apron.ml | 31 +++++++++++-------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 67bd67f4e5..ebe973536a 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -17,15 +17,20 @@ open VectorMatrix module Mpqf = SharedFunctions.Mpqf module Rhs = struct - (* (Some i, k) represents a sum of a variable with index i and the number k. - (None, k) represents the number k. *) - type t = (int option * GobZ.t) [@@deriving eq, ord, hash] - let var_zero i = (Some i, Z.zero) - let show_formatted formatter = function - | (Some v, o) when Z.equal o Z.zero -> formatter v - | (Some v, o) -> Printf.sprintf "%s%+Ld" (formatter v) (Z.to_int64 o) - | (None, o) -> Printf.sprintf "%Ld" (Z.to_int64 o) - let show rhs = show_formatted (Printf.sprintf "var_%d") rhs + (* (Some i, k,_,_) represents a sum of a variable with index i and the number k. + (None, k,_,_) represents the number k. *) + type t = (int option * GobZ.t * GobZ.t * GobZ.t) [@@deriving eq, ord, hash] + let var_zero i = (Some i, Z.zero, Z.one, Z.one) + let show_coeff c = + if Z.equal c Z.one then "" + else (Z.to_string c) ^"*" + let show_rhs_formatted formatter = function + | (Some v, o,coeff,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) + | (Some v, o,coeff,_) -> Printf.sprintf "%s%s%+Ld" (show_coeff coeff) (formatter v) (Z.to_int64 o) + | (None, o,_,_) -> Printf.sprintf "%Ld" (Z.to_int64 o) + let show (v,o,c,d) = + let rhs=show_rhs_formatted (Printf.sprintf "var_%d") (v,o,c,d) in + if not (Z.equal d Z.one) then "(" ^ rhs ^ ")/" ^ (Z.to_string d) else rhs end module EqualitiesConjunction = struct @@ -36,7 +41,7 @@ module EqualitiesConjunction = struct let show_formatted formatter econ = if IntMap.is_empty econ then "{}" else - let str = IntMap.fold (fun i (refvar,off) acc -> Printf.sprintf "%s=%s ∧ %s" (formatter i) (Rhs.show_formatted formatter (refvar,off)) acc) econ "" in + let str = IntMap.fold (fun i (refvar,off,coeff,divi) acc -> Printf.sprintf "%s%s=%s ∧ %s" (Rhs.show_coeff divi) (formatter i) (Rhs.show_rhs_formatted formatter (refvar,off,coeff,divi)) acc) econ "" in "{" ^ String.sub str 0 (String.length str - 4) ^ "}" let show econ = show_formatted (Printf.sprintf "var_%d") econ @@ -86,9 +91,9 @@ module EqualitiesConjunction = struct IntHashtbl.add h x r; r) in - let rec bumpentry k (refvar,offset) = function (* directly bumps lhs-variable during a run through indexes, bumping refvar explicitely with a new lookup in indexes *) - | (tbl,delta,head::rest) when k>=head -> bumpentry k (refvar,offset) (tbl,delta+1,rest) (* rec call even when =, in order to correctly interpret double bumps *) - | (tbl,delta,lyst) (* k (IntMap.add (op k delta) (BatOption.map (memobumpvar) refvar, offset) tbl, delta, lyst) + let rec bumpentry k (refvar,offset,coeff,divi) = function (* directly bumps lhs-variable during a run through indexes, bumping refvar explicitely with a new lookup in indexes *) + | (tbl,delta,head::rest) when k>=head -> bumpentry k (refvar,offset,coeff,divi) (tbl,delta+1,rest) (* rec call even when =, in order to correctly interpret double bumps *) + | (tbl,delta,lyst) (* k (IntMap.add (op k delta) (BatOption.map (memobumpvar) refvar,offset,coeff,divi) tbl, delta, lyst) in let (a,_,_) = IntMap.fold bumpentry map (IntMap.empty,0,offsetlist) in (* Build new map during fold with bumped key/vals *) (op dim (Array.length indexes), a) From d2ce1755e394d15e67f44c7cbc7c877ae55406ea Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 15 May 2024 13:36:49 +0200 Subject: [PATCH 002/107] adaptation of forget_variable to coefficients --- .../apron/linearTwoVarEqualityDomain.apron.ml | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index ebe973536a..ffccecb05f 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -116,17 +116,23 @@ module EqualitiesConjunction = struct (* Forget information about variable i *) let forget_variable d var = let res = - (let ref_var_opt = fst (get_rhs d var) in + (let ref_var_opt = Tuple4.first (get_rhs d var) in match ref_var_opt with | Some ref_var when ref_var = var -> (* var is the reference variable of its connected component *) (let cluster = IntMap.fold - (fun i (ref, offset) l -> if ref = ref_var_opt then i::l else l) (snd d) [] in + (fun i (ref,_,_,_) l -> if ref = ref_var_opt then i::l else l) (snd d) [] in (* obtain cluster with common reference variable ref_var*) match cluster with (* new ref_var is taken from head of the cluster *) - | head :: tail -> - let headconst = snd (get_rhs d head) in (* take offset between old and new reference variable *) - List.fold (fun map i -> set_rhs map i Z.(Some head, snd (get_rhs d i) - headconst)) d cluster (* shift offset to match new reference variable *) + | head :: _ -> + (* ax = by + c /\ a'z = b'y + c' *) + (* ==[[ y:=? ]]==> (a'b)z = (b'a)x + c' -(b'c) *) + let (_,c,b,a) = (get_rhs d head) in (* take offset between old and new reference variable *) + List.fold (fun map i -> + let (_,c',b',a') = (get_rhs d i) in + let newrhs = (Some head, Z.(c' - (b' * c)), Z.(b'*a), Z.(a'*b)) in + set_rhs map i newrhs + ) d cluster (* shift offset to match new reference variable *) | [] -> d) (* empty cluster means no work for us *) | _ -> d) (* variable is either a constant or expressed by another refvar *) in let res = (fst res, IntMap.remove var (snd res)) in (* set d(var) to unknown, finally *) From 889161995918736447ff54803286b26d040d88cb Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Wed, 15 May 2024 17:20:55 +0200 Subject: [PATCH 003/107] more accurate representation and canonicalization --- .../apron/linearTwoVarEqualityDomain.apron.ml | 59 ++++++++++++------- 1 file changed, 38 insertions(+), 21 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index ffccecb05f..8fb799804f 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -17,20 +17,30 @@ open VectorMatrix module Mpqf = SharedFunctions.Mpqf module Rhs = struct - (* (Some i, k,_,_) represents a sum of a variable with index i and the number k. - (None, k,_,_) represents the number k. *) - type t = (int option * GobZ.t * GobZ.t * GobZ.t) [@@deriving eq, ord, hash] - let var_zero i = (Some i, Z.zero, Z.one, Z.one) + (* Rhs represents coefficient*var_i + offset / divisor + depending on whether coefficient is 0, the monomial term may disappear completely, not refering to any var_i, thus: + (Some (coefficient, i), offset, divisor ) with coefficient != 0 , or + (None , offset, divisor ) *) + type t = ((GobZ.t * int) option * GobZ.t * GobZ.t) [@@deriving eq, ord, hash] + let var_zero i = (Some (Z.one,i), Z.zero, Z.one) let show_coeff c = if Z.equal c Z.one then "" else (Z.to_string c) ^"*" let show_rhs_formatted formatter = function - | (Some v, o,coeff,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) - | (Some v, o,coeff,_) -> Printf.sprintf "%s%s%+Ld" (show_coeff coeff) (formatter v) (Z.to_int64 o) - | (None, o,_,_) -> Printf.sprintf "%Ld" (Z.to_int64 o) - let show (v,o,c,d) = - let rhs=show_rhs_formatted (Printf.sprintf "var_%d") (v,o,c,d) in + | (Some (coeff,v), o,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) + | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s%+Ld" (show_coeff coeff) (formatter v) (Z.to_int64 o) + | (None, o,_) -> Printf.sprintf "%Ld" (Z.to_int64 o) + let show (v,o,d) = + let rhs=show_rhs_formatted (Printf.sprintf "var_%d") (v,o,d) in if not (Z.equal d Z.one) then "(" ^ rhs ^ ")/" ^ (Z.to_string d) else rhs + + (** factor out gcd from all terms, i.e. ax=by+c is the canonical form for adx+bdy+cd *) + let canonicalize (v,o,d) = + let gcd = Z.gcd o d in + let gcd = match v with + | Some (c,_) -> Z.gcd c gcd + | None -> gcd + in (BatOption.map (fun (coeff,i) -> (Z.div coeff gcd,i)) v,Z.div o gcd, Z.div d gcd) end module EqualitiesConjunction = struct @@ -41,7 +51,7 @@ module EqualitiesConjunction = struct let show_formatted formatter econ = if IntMap.is_empty econ then "{}" else - let str = IntMap.fold (fun i (refvar,off,coeff,divi) acc -> Printf.sprintf "%s%s=%s ∧ %s" (Rhs.show_coeff divi) (formatter i) (Rhs.show_rhs_formatted formatter (refvar,off,coeff,divi)) acc) econ "" in + let str = IntMap.fold (fun i (ref,off,divi) acc -> Printf.sprintf "%s%s=%s ∧ %s" (Rhs.show_coeff divi) (formatter i) (Rhs.show_rhs_formatted formatter (ref,off,divi)) acc) econ "" in "{" ^ String.sub str 0 (String.length str - 4) ^ "}" let show econ = show_formatted (Printf.sprintf "var_%d") econ @@ -60,13 +70,18 @@ module EqualitiesConjunction = struct (** sparse implementation of get rhs for lhs, but will default to no mapping for sparse entries *) let get_rhs (_,econmap) lhs = IntMap.find_default (Rhs.var_zero lhs) lhs econmap - (** set_rhs, staying loyal to immutable, sparse map underneath *) + (** set_rhs, staying loyal to immutable, sparse map underneath; do not attempt any normalization *) let set_rhs (dim,map) lhs rhs = (dim, if Rhs.equal rhs Rhs.(var_zero lhs) then IntMap.remove lhs map else IntMap.add lhs rhs map ) + + (** canonicalize equation, and set_rhs, staying loyal to immutable, sparse map underneath,*) + let canonicalize_and_set (dim,map) lhs rhs = set_rhs (dim,map) lhs (Rhs.canonicalize rhs) + + (** add a new equality to the domain *) let copy = identity @@ -91,9 +106,9 @@ module EqualitiesConjunction = struct IntHashtbl.add h x r; r) in - let rec bumpentry k (refvar,offset,coeff,divi) = function (* directly bumps lhs-variable during a run through indexes, bumping refvar explicitely with a new lookup in indexes *) - | (tbl,delta,head::rest) when k>=head -> bumpentry k (refvar,offset,coeff,divi) (tbl,delta+1,rest) (* rec call even when =, in order to correctly interpret double bumps *) - | (tbl,delta,lyst) (* k (IntMap.add (op k delta) (BatOption.map (memobumpvar) refvar,offset,coeff,divi) tbl, delta, lyst) + let rec bumpentry k (refvar,offset,divi) = function (* directly bumps lhs-variable during a run through indexes, bumping refvar explicitely with a new lookup in indexes *) + | (tbl,delta,head::rest) when k>=head -> bumpentry k (refvar,offset,divi) (tbl,delta+1,rest) (* rec call even when =, in order to correctly interpret double bumps *) + | (tbl,delta,lyst) (* k (IntMap.add (op k delta) (BatOption.map (fun (c,v) -> (c,memobumpvar v)) refvar,offset,divi) tbl, delta, lyst) in let (a,_,_) = IntMap.fold bumpentry map (IntMap.empty,0,offsetlist) in (* Build new map during fold with bumped key/vals *) (op dim (Array.length indexes), a) @@ -116,22 +131,24 @@ module EqualitiesConjunction = struct (* Forget information about variable i *) let forget_variable d var = let res = - (let ref_var_opt = Tuple4.first (get_rhs d var) in + (let ref_var_opt = Tuple3.first (get_rhs d var) in match ref_var_opt with - | Some ref_var when ref_var = var -> + | Some (_,ref_var) when ref_var = var -> (* var is the reference variable of its connected component *) (let cluster = IntMap.fold - (fun i (ref,_,_,_) l -> if ref = ref_var_opt then i::l else l) (snd d) [] in + (fun i (ref,_,_) l -> if ref = ref_var_opt then i::l else l) (snd d) [] in (* obtain cluster with common reference variable ref_var*) match cluster with (* new ref_var is taken from head of the cluster *) | head :: _ -> (* ax = by + c /\ a'z = b'y + c' *) (* ==[[ y:=? ]]==> (a'b)z = (b'a)x + c' -(b'c) *) - let (_,c,b,a) = (get_rhs d head) in (* take offset between old and new reference variable *) + let (newref,c,a) = (get_rhs d head) in (* take offset between old and new reference variable *) + let (b,_) = BatOption.get newref in List.fold (fun map i -> - let (_,c',b',a') = (get_rhs d i) in - let newrhs = (Some head, Z.(c' - (b' * c)), Z.(b'*a), Z.(a'*b)) in - set_rhs map i newrhs + let (oldref,c',a') = (get_rhs d i) in + let (b',_) = BatOption.get oldref in + let newrhs = (Some (Z.(b'*a),head), Z.(c' - (b' * c)), Z.(a'*b)) in + canonicalize_and_set map i newrhs ) d cluster (* shift offset to match new reference variable *) | [] -> d) (* empty cluster means no work for us *) | _ -> d) (* variable is either a constant or expressed by another refvar *) in From 19c43f6f7e9b78cfe7fd0015f25b86e60743739e Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Wed, 15 May 2024 17:55:37 +0200 Subject: [PATCH 004/107] conversion to lincons --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 8fb799804f..6fa7d9423d 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -725,14 +725,14 @@ struct lincons in let get_const acc i = function - | (None, o) -> + | (None, o, d) -> let xi = Environment.var_of_dim t.env i in - of_coeff xi [(Coeff.s_of_int (-1), xi)] o :: acc - | (Some r, _) when r = i -> acc - | (Some r, o) -> + of_coeff xi [(Coeff.s_of_int (- (Z.to_int d)), xi)] o :: acc + | (Some (c,r), _,_) when r = i -> acc + | (Some (c,r), o, d) -> let xi = Environment.var_of_dim t.env i in let ri = Environment.var_of_dim t.env r in - of_coeff xi [(Coeff.s_of_int (-1), xi); (Coeff.s_of_int 1, ri)] o :: acc + of_coeff xi [(Coeff.s_of_int (- (Z.to_int d)), xi); (Coeff.s_of_int @@ Z.to_int c, ri)] o :: acc in BatOption.get t.d |> fun (_,map) -> EConj.IntMap.fold (fun lhs rhs list -> get_const list lhs rhs) map [] From 5c2e7410da4d996ecdb255cdc0a00c5b4063242d Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Thu, 16 May 2024 09:25:08 +0200 Subject: [PATCH 005/107] [skip ci] generate coefficient-carrying monomials from texp --- .../apron/linearTwoVarEqualityDomain.apron.ml | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 6fa7d9423d..620dd307b2 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -223,14 +223,17 @@ struct let open Apron.Texpr1 in let exception NotLinearExpr in let exception ScalarIsInfinity in - let negate coeff_var_list = List.map (fun (coeff, var) -> (Z.(-coeff), var)) coeff_var_list in - let multiply_with_Z number coeff_var_list = - List.map (fun (coeff, var) -> (Z.(number * coeff, var))) coeff_var_list in + let negate coeff_var_list = List.map (function + | (Some(coeff,i),offs,divi) -> (Some(Z.neg coeff,i),Z.neg offs,divi) + | (None ,offs,divi) -> (None ,Z.neg offs,divi)) coeff_var_list in + let multiply_with_Z number divisor coeff_var_list = List.map (function + | (Some (coeff, var),offs,divi) -> Rhs.canonicalize (Some(Z.mul number coeff,var),Z.(number * offs),Z.mul divi divisor) + | (None,offs,divi) -> Rhs.canonicalize (None,Z.mul number offs,Z.mul divi divisor)) coeff_var_list in let multiply a b = (* if one of them is a constant, then multiply. Otherwise, the expression is not linear *) match a, b with - | [(a_coeff, None)], b -> multiply_with_Z a_coeff b - | a, [(b_coeff, None)] -> multiply_with_Z b_coeff a + | [(None,a_coeff, divi)], b -> multiply_with_Z a_coeff divi b + | a, [(None,b_coeff, divi)] -> multiply_with_Z b_coeff divi a | _ -> raise NotLinearExpr in let rec convert_texpr texp = @@ -239,16 +242,16 @@ struct | Cst (Interval _) -> failwith "constant was an interval; this is not supported" | Cst (Scalar x) -> begin match SharedFunctions.int_of_scalar ?round:None x with - | Some x -> [(x, None)] + | Some x -> [(None,x,Z.one)] | None -> raise ScalarIsInfinity end | Var x -> let var_dim = Environment.dim_of_var t.env x in begin match t.d with - | None -> [(Z.one, Some var_dim)] + | None -> [(Some (Z.one,var_dim),Z.zero,Z.one)] | Some d -> (match (EConj.get_rhs d var_dim) with - | (Some i, k) -> [(Z.one, Some i); (k, None)] - | (None, k) -> [(k, None)]) + | (Some (coeff,i), k,divi) -> [(Some (coeff,i),Z.zero,Z.one); (None,k,Z.one)] + | (None, k,divi) -> [ (None,k,Z.one)]) end | Unop (Neg, e, _, _) -> negate (convert_texpr e) | Unop (Cast, e, _, _) -> convert_texpr e (* Ignore since casts in apron are used for floating point nums and rounding in contrast to CIL casts *) From e97e26e175ab430dac47e5e92cd42212e6bc83a5 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 17 May 2024 15:28:02 +0200 Subject: [PATCH 006/107] [skip ci] migrated meet_with_one_conj --- .../apron/linearTwoVarEqualityDomain.apron.ml | 68 ++++++++++++++----- 1 file changed, 51 insertions(+), 17 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 620dd307b2..1793f38de8 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -41,6 +41,14 @@ module Rhs = struct | Some (c,_) -> Z.gcd c gcd | None -> gcd in (BatOption.map (fun (coeff,i) -> (Z.div coeff gcd,i)) v,Z.div o gcd, Z.div d gcd) + + (** Substitute rhs for varx in rhs' *) + let subst rhs varx rhs' = + match rhs,rhs' with + | (Some (c,x),o,d),(Some (c',x'),o',d') when x'=varx -> canonicalize (Some (Z.mul c c',x),Z.((o*c')+(d*o')),Z.mul d d') + | (None ,o,d),(Some (c',x'),o',d') when x'=varx -> canonicalize (None ,Z.((o*c')+(d*o')),Z.mul d d') + | _ -> rhs' + end module EqualitiesConjunction = struct @@ -67,6 +75,9 @@ module EqualitiesConjunction = struct (** trivial equalities are of the form var_i = var_i and are not kept explicitely in the sparse representation of EquanlitiesConjunction *) let nontrivial (_,econmap) lhs = IntMap.mem lhs econmap + (** turn x = (cy+o)/d into y = (dx-o)/c*) + let reverse x (c,y,o,d) = (y,(Some (d,x),Z.neg o,c)) + (** sparse implementation of get rhs for lhs, but will default to no mapping for sparse entries *) let get_rhs (_,econmap) lhs = IntMap.find_default (Rhs.var_zero lhs) lhs econmap @@ -181,29 +192,52 @@ module EqualitiesConjunction = struct exception Contradiction - let meet_with_one_conj ts i (var, b) = + let meet_with_one_conj ts i (var, offs, divi) = + let (var,offs,divi) = Rhs.canonicalize (var,offs,divi) in (* make sure that the one new conj is properly canonicalized *) let res = - let subst_var tsi x (vart, bt) = + let subst_var tsi x (vary, o, d) = + (* [[x substby (cy+o)/d ]] ((c'x+o')/d') *) + (* =====> (c'cy + c'o+o'd)/(dd') *) let adjust = function - | (Some vare, b') when vare = x -> (vart, Z.(b' + bt)) + | (Some (c',varx), o',d') when varx = x -> Rhs.canonicalize (BatOption.map (fun (c,y)->(Z.mul c c',y)) vary, Z.((c'*o)+(o'*d)),Z.(d'*d)) | e -> e in - (fst tsi, IntMap.add x (vart, bt) @@ IntMap.map adjust (snd tsi)) (* in case of sparse representation, make sure that the equality is now included in the conjunction *) + (fst tsi, IntMap.add x (vary, o, d) @@ IntMap.map adjust (snd tsi)) (* in case of sparse representation, make sure that the equality is now included in the conjunction *) in - let (var1, b1) = get_rhs ts i in - (match var, var1 with - | None , None -> if not @@ Z.equal b b1 then raise Contradiction else ts - | None , Some h1 -> subst_var ts h1 (None, Z.(b - b1)) - | Some j, None -> subst_var ts j (None, Z.(b1 - b)) - | Some j, Some h1 -> + (match var, (get_rhs ts i) with + (*| new conj , old conj *) + | None , (None , o1, divi1) -> if not @@ (Z.equal offs o1 && Z.equal divi divi1) then raise Contradiction else ts + (* o/d = x_i = (c1*x_h1+o1)/d1 *) + (* ======> x_h1 = (o*d1-o1*d)/(d*c1) /\ x_i = o/d *) + | None , (Some (coeff1,h1), o1, divi1) -> subst_var ts h1 (None, Z.(offs*divi1 - o1*divi),Z.(divi*coeff1)) + (* (c*x_j+o)/d = x_i = o1/d1 *) + (* ======> x_j = (o1*d-o*d1)/(d1*c) /\ x_i = o1/d1 *) + | Some (coeff,j), (None , o1, divi1) -> subst_var ts j (None, Z.(o1*divi - offs*divi1),Z.(divi1*coeff)) + (* (c*x_j+o)/d = x_i = (c1*x_h1+o1)/d1 *) + (* ======> x_j needs normalization wrt. ts *) + | Some (coeff,j), ((Some (coeff1,h1), o1, divi1) as oldi)-> (match get_rhs ts j with - | (None, b2) -> subst_var ts i (None, Z.(b2 + b)) - | (Some h2, b2) -> - if h1 = h2 then - (if not @@ Z.equal b1 Z.(b2 + b) then raise Contradiction else ts) - else if h1 < h2 then subst_var ts h2 (Some h1, Z.(b1 - (b + b2))) - else subst_var ts h1 (Some h2, Z.(b + (b2 - b1))))) in - if M.tracing then M.trace "meet" "meet_with_one_conj conj: { %s } eq: var_%d=%s -> { %s } " (show (snd ts)) i (Rhs.show (var,b)) (show (snd ts)) + (* ts[x_j]=o2/d2 ========> ... *) + | (None , o2, divi2) -> + let newxi = Rhs.subst (None,o2,divi2) j (Some (coeff,j),offs,divi) in + let newxh1 = snd @@ reverse i (coeff1,h1,o1,divi1) in + let newxh1 = Rhs.subst newxi i newxh1 in + subst_var ts h1 newxh1 + (* ts[x_j]=(c2*x_h2+o2)/d2 ========> ... *) + | (Some (coeff2,h2), o2, divi2) as normalizedj -> + if h1 = h2 then (* this is the case where x_i and x_j already where in the same equivalence class; let's see whether the new equality contradicts the old one *) + let normalizedi= Rhs.subst normalizedj j (Some(coeff,j),offs,divi) in + (if not @@ Rhs.equal normalizedi oldi then raise Contradiction else ts) + else if h1 < h2 (* good, we no unite the two equvalence classes; let's decide upon the representant *) + then (* express h2 in terms of h1: *) + let (_,newh2)= reverse j (coeff2,h2,o2,divi2) in + let newh2 = Rhs.subst oldi i (Rhs.subst (snd @@ reverse i (coeff,j,offs,divi)) j newh2) in + subst_var ts h2 newh2 + else (* express h1 in terms of h2: *) + let (_,newh1)= reverse i (coeff1,h1,o1,divi1) in + let newh1 = Rhs.subst normalizedj j (Rhs.subst (Some(coeff,j),offs,divi) i newh1) in + subst_var ts h1 newh1)) in + if M.tracing then M.trace "meet" "meet_with_one_conj conj: { %s } eq: var_%d=%s -> { %s } " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd ts)) ; res end From a9248db7e355c7dfa74182acaa8eeab55abfb866 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 17 May 2024 15:38:23 +0200 Subject: [PATCH 007/107] [skip ci] tiny migration steps, low hanging fruit --- .../apron/linearTwoVarEqualityDomain.apron.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 1793f38de8..6d6363329b 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -327,7 +327,7 @@ struct (* Copy because function is not "with" so should not mutate inputs *) let assign_const t var const = match t.d with | None -> t - | Some t_d -> {d = Some (EConj.set_rhs t_d var (None, const)); env = t.env} + | Some t_d -> {d = Some (EConj.set_rhs t_d var (None, const,Z.one)); env = t.env} let subtract_const_from_var t var const = match t.d with @@ -419,12 +419,12 @@ struct let printXml f x = BatPrintf.fprintf f "\n\n\nequalities\n\n\n%s\n\nenv\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) (XmlUtil.escape (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (x.env))) let eval_interval ask = Bounds.bound_texpr - let meet_with_one_conj t i (var, b) = + let meet_with_one_conj t i (var, o, divi) = match t.d with | None -> t | Some d -> try - { d = Some (EConj.meet_with_one_conj d i (var, b)); env = t.env} + { d = Some (EConj.meet_with_one_conj d i (var, o, divi)); env = t.env} with EConj.Contradiction -> if M.tracing then M.trace "meet" " -> Contradiction\n"; { d = None; env = t.env} @@ -585,7 +585,7 @@ struct subtract_const_from_var t var_i off | Some (Some exp_var, off) -> (* Statement "assigned_var = exp_var + off" (assigned_var is not the same as exp_var) *) - meet_with_one_conj (forget_var t var) var_i (Some exp_var, off) + meet_with_one_conj (forget_var t var) var_i (Some (Z.one,exp_var), off, Z.one) end | None -> bot_env @@ -702,13 +702,13 @@ struct end | [(varexpr, index)] -> (* guard has a single reference variable only *) if Tcons1.get_typ tcons = EQ && Z.divisible constant varexpr then - meet_with_one_conj t index (None, (Z.(-(constant) / varexpr))) + meet_with_one_conj t index (None, (Z.(-(constant) / varexpr)),Z.one) else t (* only EQ is supported in equality based domains *) | [(a1,var1); (a2,var2)] -> (* two variables in relation needs a little sorting out *) begin match Tcons1.get_typ tcons with | EQ when Z.(a1 * a2 = -one) -> (* var1-var1 or var2-var1 *) - meet_with_one_conj t var2 (Some var1, Z.mul a1 constant) + meet_with_one_conj t var2 (Some (Z.one,var1), Z.mul a1 constant,Z.one) | _-> t (* Not supported in equality based 2vars without coeffiients *) end | _ -> t (* For equalities of more then 2 vars we just return t *)) From 1257b680109575bf79157d33f503eb23c7413fb1 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Sun, 19 May 2024 23:23:50 +0200 Subject: [PATCH 008/107] [skip ci] dealt with simplifying linear expressions to lin2vars with coeffs --- .../apron/linearTwoVarEqualityDomain.apron.ml | 47 ++++++++++--------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 6d6363329b..1e60f28e8f 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -260,14 +260,14 @@ struct let negate coeff_var_list = List.map (function | (Some(coeff,i),offs,divi) -> (Some(Z.neg coeff,i),Z.neg offs,divi) | (None ,offs,divi) -> (None ,Z.neg offs,divi)) coeff_var_list in - let multiply_with_Z number divisor coeff_var_list = List.map (function - | (Some (coeff, var),offs,divi) -> Rhs.canonicalize (Some(Z.mul number coeff,var),Z.(number * offs),Z.mul divi divisor) - | (None,offs,divi) -> Rhs.canonicalize (None,Z.mul number offs,Z.mul divi divisor)) coeff_var_list in + let multiply_with_Q dividend divisor coeff_var_list = List.map (function + | (Some (coeff, var),offs,divi) -> Rhs.canonicalize (Some(Z.mul dividend coeff,var),Z.(dividend * offs),Z.mul divi divisor) + | (None,offs,divi) -> Rhs.canonicalize (None,Z.mul dividend offs,Z.mul divi divisor)) coeff_var_list in let multiply a b = (* if one of them is a constant, then multiply. Otherwise, the expression is not linear *) match a, b with - | [(None,a_coeff, divi)], b -> multiply_with_Z a_coeff divi b - | a, [(None,b_coeff, divi)] -> multiply_with_Z b_coeff divi a + | [(None,coeff, divi)], c + | c, [(None,coeff, divi)] -> multiply_with_Q coeff divi c | _ -> raise NotLinearExpr in let rec convert_texpr texp = @@ -284,8 +284,8 @@ struct | None -> [(Some (Z.one,var_dim),Z.zero,Z.one)] | Some d -> (match (EConj.get_rhs d var_dim) with - | (Some (coeff,i), k,divi) -> [(Some (coeff,i),Z.zero,Z.one); (None,k,Z.one)] - | (None, k,divi) -> [ (None,k,Z.one)]) + | (Some (coeff,i), k,divi) -> [(Some (coeff,i),Z.zero,divi); (None,k,divi)] + | (None, k,divi) -> [ (None,k,divi)]) end | Unop (Neg, e, _, _) -> negate (convert_texpr e) | Unop (Cast, e, _, _) -> convert_texpr e (* Ignore since casts in apron are used for floating point nums and rounding in contrast to CIL casts *) @@ -299,27 +299,27 @@ struct | exception ScalarIsInfinity -> None | x -> Some(x) - (** convert and simplify (wrt. reference variables) a texpr into a tuple of a list of monomials and a constant *) + (** convert and simplify (wrt. reference variables) a texpr into a tuple of a list of monomials (coeff,varidx,divi) and a (constant/divi) *) let simplified_monomials_from_texp (t: t) texp = BatOption.bind (monomials_from_texp t texp) (fun monomiallist -> let d = Option.get t.d in - let expr = Array.make (Environment.size t.env) Z.zero in - let accumulate_constants a (c, v) = match v with - | None -> Z.(a + c) - | Some idx -> let (term,con) = (EConj.get_rhs d idx) in - (Option.may (fun ter -> expr.(ter) <- Z.(expr.(ter) + c)) term; - Z.(a + c * con)) + let expr = Array.make (Environment.size t.env) (Q.zero) in (*TODO*: migrate to map; array of coeff/divisor per var idx*) + let accumulate_constants (aconst,adiv) (v,offs,divi) = match v with + | None -> let gcdee = Z.gcd adiv divi in (Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi) + | Some (coeff,idx) -> let (somevar,someoffs,somedivi)=Rhs.subst (EConj.get_rhs d idx) idx (v,offs,divi) in (* normalize! *) + (Option.may (fun (coef,ter) -> expr.(ter) <- Q.(expr.(ter) + Q.make coef somedivi)) somevar; + let gcdee = Z.gcd adiv divi in (Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi)) in - let constant = List.fold_left accumulate_constants Z.zero monomiallist in (* abstract simplification of the guard wrt. reference variables *) - Some (Array.fold_lefti (fun list v (c) -> if Z.equal c Z.zero then list else (c,v)::list) [] expr, constant) ) + let constant = List.fold_left accumulate_constants (Z.zero,Z.one) monomiallist in (* abstract simplification of the guard wrt. reference variables *) + Some (Array.fold_lefti (fun list v (c) -> if Q.equal c Q.zero then list else (c.num,v,c.den)::list) [] expr, constant) ) let simplify_to_ref_and_offset (t: t) texp = BatOption.bind (simplified_monomials_from_texp t texp ) - (fun (sum_of_terms, constant) -> + (fun (sum_of_terms, (constant,divisor)) -> (match sum_of_terms with - | [] -> Some (None, constant) - | [(coeff,var)] when Z.equal coeff Z.one -> Some (Some var, constant) + | [] -> Some (None, constant,divisor) + | [(coeff,var,divi)] when Z.equal coeff Z.one -> Some (Rhs.canonicalize (Some (Z.mul divisor coeff,var), Z.mul constant divi,Z.mul divisor divi)) |_ -> None)) let simplify_to_ref_and_offset t texp = timing_wrap "coeff_vec" (simplify_to_ref_and_offset t) texp @@ -364,9 +364,12 @@ struct if t.d = None then None, None else match simplify_to_ref_and_offset t (Texpr1.to_expr texpr) with - | Some (None, offset) -> - (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string offset) (IntOps.BigIntOps.to_string offset); - Some offset, Some offset) + | Some (None, offset, divisor) when Z.equal (Z.rem offset divisor) Z.zero -> let res = Z.div offset divisor in + (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string res) (IntOps.BigIntOps.to_string res); + Some res, Some res) + | Some (None, offset, divisor) -> let res = Z.div offset divisor in + (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string res) (IntOps.BigIntOps.to_string (Z.add res Z.one)); + Some res, Some (Z.add res Z.one); failwith "ToDo: Rethink interval bounds (add or subtract depending on sign of res)") | _ -> None, None let bound_texpr d texpr1 = timing_wrap "bounds calculation" (bound_texpr d) texpr1 From 034492e12c4772f0d06af8f8de305b66703a0839 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Mon, 20 May 2024 23:32:21 +0200 Subject: [PATCH 009/107] [skip ci] replaced overspecialized subtract_with_constant by affine_transform --- .../apron/linearTwoVarEqualityDomain.apron.ml | 70 ++++++++----------- 1 file changed, 31 insertions(+), 39 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 1e60f28e8f..b296a3420d 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -76,7 +76,7 @@ module EqualitiesConjunction = struct let nontrivial (_,econmap) lhs = IntMap.mem lhs econmap (** turn x = (cy+o)/d into y = (dx-o)/c*) - let reverse x (c,y,o,d) = (y,(Some (d,x),Z.neg o,c)) + let inverse x (c,y,o,d) = (y,(Some (d,x),Z.neg o,c)) (** sparse implementation of get rhs for lhs, but will default to no mapping for sparse entries *) let get_rhs (_,econmap) lhs = IntMap.find_default (Rhs.var_zero lhs) lhs econmap @@ -220,7 +220,7 @@ module EqualitiesConjunction = struct (* ts[x_j]=o2/d2 ========> ... *) | (None , o2, divi2) -> let newxi = Rhs.subst (None,o2,divi2) j (Some (coeff,j),offs,divi) in - let newxh1 = snd @@ reverse i (coeff1,h1,o1,divi1) in + let newxh1 = snd @@ inverse i (coeff1,h1,o1,divi1) in let newxh1 = Rhs.subst newxi i newxh1 in subst_var ts h1 newxh1 (* ts[x_j]=(c2*x_h2+o2)/d2 ========> ... *) @@ -230,16 +230,32 @@ module EqualitiesConjunction = struct (if not @@ Rhs.equal normalizedi oldi then raise Contradiction else ts) else if h1 < h2 (* good, we no unite the two equvalence classes; let's decide upon the representant *) then (* express h2 in terms of h1: *) - let (_,newh2)= reverse j (coeff2,h2,o2,divi2) in - let newh2 = Rhs.subst oldi i (Rhs.subst (snd @@ reverse i (coeff,j,offs,divi)) j newh2) in + let (_,newh2)= inverse j (coeff2,h2,o2,divi2) in + let newh2 = Rhs.subst oldi i (Rhs.subst (snd @@ inverse i (coeff,j,offs,divi)) j newh2) in subst_var ts h2 newh2 else (* express h1 in terms of h2: *) - let (_,newh1)= reverse i (coeff1,h1,o1,divi1) in + let (_,newh1)= inverse i (coeff1,h1,o1,divi1) in let newh1 = Rhs.subst normalizedj j (Rhs.subst (Some(coeff,j),offs,divi) i newh1) in subst_var ts h1 newh1)) in if M.tracing then M.trace "meet" "meet_with_one_conj conj: { %s } eq: var_%d=%s -> { %s } " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd ts)) ; res + (** affine transform variable i allover conj with transformer (Some (coeff,i)+offs)/divi *) + let affine_transform econ i (var,offs,divi) = + if nontrivial econ i then (** i cannot occur on any other rhs apart from itself *) + set_rhs econ i (Rhs.subst (get_rhs econ i) i (var,offs,divi)) + else (* var_i = var_i, i.e. it may occur on the rhs of other equalities *) + match var with + | None -> failwith "this is not a valid affine transformation" + | Some (coeff,j) -> + (* so now, we transform with the inverse of the transformer: *) + let inv = snd (inverse i (coeff,j,offs,divi)) in + IntMap.fold (fun k v acc -> + match v with + | (Some (c,x),o,d) when x=i-> set_rhs acc k (Rhs.subst inv i v) + | _ -> acc + ) (snd econ) econ + end (** [VarManagement] defines the type t of the affine equality domain (a record that contains an optional matrix and an apron environment) and provides the functions needed for handling variables (which are defined by [RelationDomain.D2]) such as [add_vars], [remove_vars]. @@ -325,33 +341,9 @@ struct let simplify_to_ref_and_offset t texp = timing_wrap "coeff_vec" (simplify_to_ref_and_offset t) texp (* Copy because function is not "with" so should not mutate inputs *) - let assign_const t var const = match t.d with - | None -> t - | Some t_d -> {d = Some (EConj.set_rhs t_d var (None, const,Z.one)); env = t.env} - - let subtract_const_from_var t var const = - match t.d with + let assign_const t var const divi = match t.d with | None -> t - | Some t_d -> - let subtract_const_from_var_for_single_equality index (eq_var_opt, off2) econ = - if index <> var then - begin match eq_var_opt with - | Some eq_var when eq_var = var -> - EConj.set_rhs econ index (eq_var_opt, Z.(off2 - const)) - | _ -> econ - end - else econ - in - let d = - if not @@ EConj.nontrivial t_d var - (* var is a reference variable -> it can appear on the right-hand side of an equality *) - then - (EConj.IntMap.fold (subtract_const_from_var_for_single_equality) (snd t_d) t_d) - else - (* var never appears on the right hand side-> we only need to modify the array entry at index var *) - EConj.set_rhs t_d var (Tuple2.map2 (Z.add const) (EConj.get_rhs t_d var)) - in - {d = Some d; env = t.env} + | Some t_d -> {d = Some (EConj.set_rhs t_d var (None, const, divi)); env = t.env} end @@ -580,15 +572,15 @@ struct | None -> (* Statement "assigned_var = ?" (non-linear assignment) *) forget_var t var - | Some (None, off) -> + | Some (None, off, divi) -> (* Statement "assigned_var = off" (constant assignment) *) - assign_const (forget_var t var) var_i off - | Some (Some exp_var, off) when var_i = exp_var -> - (* Statement "assigned_var = assigned_var + off" *) - subtract_const_from_var t var_i off - | Some (Some exp_var, off) -> - (* Statement "assigned_var = exp_var + off" (assigned_var is not the same as exp_var) *) - meet_with_one_conj (forget_var t var) var_i (Some (Z.one,exp_var), off, Z.one) + assign_const (forget_var t var) var_i off divi + | Some (Some (coeff_var,exp_var), off, divi) when var_i = exp_var -> + (* Statement "assigned_var = (coeff_var*assigned_var + off) / divi" *) + {d=Some (EConj.affine_transform d var_i (Some (coeff_var, var_i), off, divi)); env=t.env } + | Some (Some monomial, off, divi) -> + (* Statement "assigned_var = (monomial) + off / divi" (assigned_var is not the same as exp_var) *) + meet_with_one_conj (forget_var t var) var_i (Some (monomial), off, divi) end | None -> bot_env From 4d2668177c4bde52a89897253c2327806954b22c Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 21 May 2024 08:52:54 +0200 Subject: [PATCH 010/107] [skip ci] bounds --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index b296a3420d..a0bbcbce39 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -360,8 +360,12 @@ struct (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string res) (IntOps.BigIntOps.to_string res); Some res, Some res) | Some (None, offset, divisor) -> let res = Z.div offset divisor in - (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string res) (IntOps.BigIntOps.to_string (Z.add res Z.one)); - Some res, Some (Z.add res Z.one); failwith "ToDo: Rethink interval bounds (add or subtract depending on sign of res)") + let (lower,upper) = if Z.lt res Z.zero then + (Z.sub res Z.one,res) + else + (res,Z.add res Z.one) in + (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string lower) (IntOps.BigIntOps.to_string upper); + Some lower, Some upper) | _ -> None, None let bound_texpr d texpr1 = timing_wrap "bounds calculation" (bound_texpr d) texpr1 From fa58e2e301432c85c89b596d1c87b0923816c833 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 21 May 2024 09:24:25 +0200 Subject: [PATCH 011/107] [skip ci] leq/implies now also for coefficients --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index a0bbcbce39..5234f8d2fa 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -451,11 +451,13 @@ struct let leq t1 t2 = let env_comp = Environment.compare t1.env t2.env in (* Apron's Environment.compare has defined return values. *) - let implies ts i (var, b) = - let tuple_cmp = Tuple2.eq (Option.eq ~eq:Int.equal) (Z.equal) in + let implies ts i (var, offs, divi) = + let tuple_cmp = Tuple3.eq (Option.eq ~eq:(Tuple2.eq (Z.equal) (Int.equal))) (Z.equal) (Z.equal) in match var with - | None -> tuple_cmp (var, b) (EConj.get_rhs ts i) - | Some j -> tuple_cmp (EConj.get_rhs ts i) @@ Tuple2.map2 (Z.add b) (EConj.get_rhs ts j) + (* directly compare in case of constant value *) + | None -> tuple_cmp (var, offs, divi) (EConj.get_rhs ts i) + (* normalize in case of a full blown equality *) + | Some (coeffj,j) -> tuple_cmp (EConj.get_rhs ts i) @@ Rhs.subst (EConj.get_rhs ts j) j (var, offs, divi) in if env_comp = -2 || env_comp > 0 then false else if is_bot_env t1 || is_top t2 then true else From ba485801970de0bf25618b8516b8ef4a89549523 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 21 May 2024 10:42:15 +0200 Subject: [PATCH 012/107] [skip ci] migrated meet_tcons --- .../apron/linearTwoVarEqualityDomain.apron.ml | 21 ++++++++++++------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 5234f8d2fa..51c6d702ef 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -690,9 +690,9 @@ struct | Some d -> match simplified_monomials_from_texp t (Texpr1.to_expr @@ Tcons1.get_texpr1 tcons) with | None -> t - | Some (sum_of_terms, constant) ->( + | Some (sum_of_terms, (constant,divisor)) ->( match sum_of_terms with - | [] -> (* no reference variables in the guard *) + | [] -> (* no reference variables in the guard, so check constant for zero *) begin match Tcons1.get_typ tcons with | EQ when Z.equal constant Z.zero -> t | SUPEQ when Z.geq constant Z.zero -> t @@ -701,15 +701,20 @@ struct | EQMOD _ -> t | _ -> bot_env (* all other results are violating the guard *) end - | [(varexpr, index)] -> (* guard has a single reference variable only *) - if Tcons1.get_typ tcons = EQ && Z.divisible constant varexpr then - meet_with_one_conj t index (None, (Z.(-(constant) / varexpr)),Z.one) + | [(coeff, index, divi)] -> (* guard has a single reference variable only *) + if Tcons1.get_typ tcons = EQ then + meet_with_one_conj t index (Rhs.canonicalize (None, Z.(divi*constant),Z.(coeff*divisor))) else t (* only EQ is supported in equality based domains *) - | [(a1,var1); (a2,var2)] -> (* two variables in relation needs a little sorting out *) + | [(c1,var1,d1); (c2,var2,d2)] -> (* two variables in relation needs a little sorting out *) begin match Tcons1.get_typ tcons with - | EQ when Z.(a1 * a2 = -one) -> (* var1-var1 or var2-var1 *) - meet_with_one_conj t var2 (Some (Z.one,var1), Z.mul a1 constant,Z.one) + | EQ -> (* c1*var1/d1 + c2*var2/d2 +constant/divisor = 0*) + (* ======> c1*divisor*d2 * var1 = -c2*divisor*d1 * var2 +constant*-d1*d2*) + (* \/ c2*divisor*d1 * var2 = -c1*divisor*d2 * var1 +constant*-d1*d2*) + if var1 < var2 then + meet_with_one_conj t var2 (Rhs.canonicalize (Some (Z.neg @@ Z.(c1*divisor),var1),Z.neg @@ Z.(constant*d2*d1),Z.(c2*divisor*d1))) + else + meet_with_one_conj t var1 (Rhs.canonicalize (Some (Z.neg @@ Z.(c2*divisor),var2),Z.neg @@ Z.(constant*d2*d1),Z.(c1*divisor*d2))) | _-> t (* Not supported in equality based 2vars without coeffiients *) end | _ -> t (* For equalities of more then 2 vars we just return t *)) From 80ef4bd311de6fb433683c042de56706e8cc7db8 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 21 May 2024 17:51:05 +0200 Subject: [PATCH 013/107] [skip ci] formulated new join sorting criterium --- .../apron/linearTwoVarEqualityDomain.apron.ml | 36 ++++++++++--------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 51c6d702ef..8e6a97d18c 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -478,32 +478,36 @@ struct (* joinfunction handles the dirty details of performing an "inner join" on the lhs of both bindings; in the resulting binding, the lhs is then mapped to values that are later relevant for sorting/grouping, i.e. - lhs itself - - the difference of both offsets + - the affine transformation from refvar1 to refvar2, i.E. the parameters A and B of the general affine transformer Ax+B - rhs1 - rhs2 however, we have to account for the sparseity of EConj maps by manually patching holes with default values *) - let joinfunction lhs rhs1 rhs2 = match rhs1, rhs2 with - | Some (ai,aj),Some (bi,bj) -> Some (lhs,Z.(aj - bj),(ai,aj),(bi,bj)) (* this is explicitely what we want *) - | None, Some (bi,bj) -> Some (lhs,Z.neg bj ,Rhs.var_zero lhs,(bi,bj)) (* account for the sparseity of binding 1 *) - | Some (ai,aj), None -> Some (lhs,aj ,(ai,aj),Rhs.var_zero lhs) (* account for the sparseity of binding 2 *) - | _,_ -> None (* no binding for lhs in both maps is replicated implicitely in a sparse result map *) + let joinfunction lhs rhs1 rhs2 = let coeff = Option.map_default fst Z.one in match rhs1, rhs2 with + (* Compute Ax+B such that (coeff1*(Ax+B)+off1)/d1 = (coeff2*x+off2)/d2 *) + (* ====> A = (coeff2*d1)/(coeff1*d2) /\ B = (off2*d1-off1*d2)/(c1*c2) *) + (* lhs A B rhs1 rhs2 *) + (*TODO*: if this works, make it more concise *) + | Some (ai,aj,ak), Some (bi,bj,bk) -> Some (lhs,Q.make Z.(ak*coeff bi) Z.(bk* coeff ai),Q.make Z.(bj*ak-aj*bk) Z.(bk*coeff ai), (ai,aj,ak) , (bi,bj,bk)) (* this is explicitely what we want *) + | None , Some (bi,bj,bk) -> Some (lhs,Q.make Z.( coeff bi) Z.(bk ),Q.make Z.(bj ) Z.(bk ), Rhs.var_zero lhs, (bi,bj,bk)) (* account for the sparseity of binding 1 *) + | Some (ai,aj,ak), None -> Some (lhs,Q.make Z.(ak ) Z.( coeff ai),Q.make Z.( neg aj) Z.( coeff ai), (ai,aj,ak), Rhs.var_zero lhs) (* account for the sparseity of binding 2 *) + | _,_ -> None (* no binding for lhs in both maps is replicated implicitely in a sparse result map *) in let table = List.of_enum @@ EConj.IntMap.values @@ EConj.IntMap.merge joinfunction (snd ad) (snd bd) in - (*compare two variables for grouping depending on delta function and reference index*) - let cmp_z (_, t0i, t1i, t2i) (_, t0j, t1j, t2j) = - let cmp_ref = Option.compare ~cmp:Int.compare in - Tuple3.compare ~cmp1:cmp_ref ~cmp2:cmp_ref ~cmp3:Z.compare (fst t1i, fst t2i, t0i) (fst t1j, fst t2j, t0j) + (* compare two variables for grouping depending on affine function parameters a, b and reference variable indices *) + let cmp_z (_, ai, bi, t1i, t2i) (_, aj, bj, t1j, t2j) = + let cmp_ref = Option.compare ~cmp:(fun x y -> Int.compare (snd x) (snd y)) in + Tuple4.compare ~cmp1:cmp_ref ~cmp2:cmp_ref ~cmp3:Q.compare ~cmp4:Q.compare (Tuple3.first t1i, Tuple3.first t2i, ai, bi) (Tuple3.first t1j, Tuple3.first t2j, aj, bj) in - (*Calculate new components as groups*) + (* Calculate new components as groups *) let new_components = BatList.group cmp_z table in - (*Adjust the domain array to represent the new components*) - let modify map idx_h b_h (idx, _, (opt1, z1), (opt2, z2)) = EConj.set_rhs map (idx) - (if opt1 = opt2 && Z.equal z1 z2 then (opt1, z1) - else (Some idx_h, Z.(z1 - b_h))) + (* Adjust the domain map to represent the new components *) + let modify map idx_h offs_h (idx, _, _, (opt1, z1, d1), (opt2, z2, d2)) = EConj.set_rhs map (idx) + (if opt1 = opt2 && Z.equal z1 z2 && Z.equal d1 d2 then (opt1, z1, d1) + else (Some idx_h, Z.(z1 - offs_h))) in let iterate map l = match l with - | (idx_h, _, (_, b_h), _) :: t -> List.fold (fun map' e -> modify map' idx_h b_h e) map l + | (idx_h, _, _, (_, offs_h, divi_h), _) :: t -> List.fold (fun map' e -> modify map' idx_h offs_h e) map l | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From 7e5b727373e27d3cd0565ccb9f44fc9936934197 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 21 May 2024 18:03:23 +0200 Subject: [PATCH 014/107] [skip ci] satisfy semgrep --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 8e6a97d18c..6c12744228 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -361,9 +361,9 @@ struct Some res, Some res) | Some (None, offset, divisor) -> let res = Z.div offset divisor in let (lower,upper) = if Z.lt res Z.zero then - (Z.sub res Z.one,res) + (Z.pred res,res) else - (res,Z.add res Z.one) in + (res,Z.succ res) in (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string lower) (IntOps.BigIntOps.to_string upper); Some lower, Some upper) | _ -> None, None From ad01be4ebe8012ee02bd1537386dbf00bd3cad1c Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 22 May 2024 10:27:40 +0200 Subject: [PATCH 015/107] [skip ci] finally affine transform the reference variables in join --- .../apron/linearTwoVarEqualityDomain.apron.ml | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 6c12744228..cff8cab293 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -501,13 +501,16 @@ struct (* Calculate new components as groups *) let new_components = BatList.group cmp_z table in (* Adjust the domain map to represent the new components *) - let modify map idx_h offs_h (idx, _, _, (opt1, z1, d1), (opt2, z2, d2)) = EConj.set_rhs map (idx) - (if opt1 = opt2 && Z.equal z1 z2 && Z.equal d1 d2 then (opt1, z1, d1) - else (Some idx_h, Z.(z1 - offs_h))) + let modify map x (refmonom, offs, divi) (idx, _, _, (monom1, z1, d1), (monom2, z2, d2)) = EConj.set_rhs map (idx) + (if monom1 = monom2 && Z.equal z1 z2 && Z.equal d1 d2 then (monom1, z1, d1) + else + let refcoeff = Option.map_default fst Z.one refmonom in + let coeff1 = Option.map_default fst Z.one monom1 in + (Some (Z.(coeff1*divi),x), Z.((z1*refcoeff)-(offs*coeff1)), Z.(refcoeff*d1)) ) in let iterate map l = match l with - | (idx_h, _, _, (_, offs_h, divi_h), _) :: t -> List.fold (fun map' e -> modify map' idx_h offs_h e) map l + | (idx_h, _, _, rhs_h, _) :: t -> List.fold (fun acc e -> modify acc idx_h rhs_h e) map l | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From 9923eafdc167b0453cfad0cff3d4fffdc5617c0c Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 22 May 2024 11:28:29 +0200 Subject: [PATCH 016/107] cosmetics --- .../apron/linearTwoVarEqualityDomain.apron.ml | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index cff8cab293..6346dc0975 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -25,7 +25,8 @@ module Rhs = struct let var_zero i = (Some (Z.one,i), Z.zero, Z.one) let show_coeff c = if Z.equal c Z.one then "" - else (Z.to_string c) ^"*" + else if Z.equal c Z.minus_one then "-" + else (Z.to_string c) ^"·" let show_rhs_formatted formatter = function | (Some (coeff,v), o,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s%+Ld" (show_coeff coeff) (formatter v) (Z.to_int64 o) @@ -404,7 +405,13 @@ struct (** prints the current variable equalities with resolved variable names *) let show varM = - let lookup i = Var.to_string (Environment.var_of_dim varM.env i) in + let lookup i = + let transl = [|"₀";"₁";"₂";"₃";"₄";"₅";"₆";"₇";"₈";"₉"|] in + let res = Var.to_string (Environment.var_of_dim varM.env i) in + match String.split_on_char '#' res with + | varname::rest::[] -> varname ^ (try String.fold_left (fun acc c -> acc ^ transl.(Char.code c - Char.code '0')) "" rest with _ -> "#"^rest) + | _ -> failwith "Variable name not found" + in match varM.d with | None -> "⊥\n" | Some arr when EConj.is_top_con arr -> "⊤\n" From dfeb71537c731b2c839afe04df1379f799f74fb5 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 22 May 2024 14:59:16 +0200 Subject: [PATCH 017/107] sign errors corrected --- .../apron/linearTwoVarEqualityDomain.apron.ml | 40 +++++++++++++------ 1 file changed, 27 insertions(+), 13 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 6346dc0975..d51bebb332 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -41,7 +41,8 @@ module Rhs = struct let gcd = match v with | Some (c,_) -> Z.gcd c gcd | None -> gcd - in (BatOption.map (fun (coeff,i) -> (Z.div coeff gcd,i)) v,Z.div o gcd, Z.div d gcd) + in let gcd = if (Z.(lt d Z.zero)) then Z.neg gcd else gcd in + (BatOption.map (fun (coeff,i) -> (Z.div coeff gcd,i)) v,Z.div o gcd, Z.div d gcd) (** Substitute rhs for varx in rhs' *) let subst rhs varx rhs' = @@ -238,7 +239,7 @@ module EqualitiesConjunction = struct let (_,newh1)= inverse i (coeff1,h1,o1,divi1) in let newh1 = Rhs.subst normalizedj j (Rhs.subst (Some(coeff,j),offs,divi) i newh1) in subst_var ts h1 newh1)) in - if M.tracing then M.trace "meet" "meet_with_one_conj conj: { %s } eq: var_%d=%s -> { %s } " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd ts)) + if M.tracing then M.trace "meet_with_one_conj" "meet_with_one_conj conj: %s eq: var_%d=%s -> %s " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd ts)) ; res (** affine transform variable i allover conj with transformer (Some (coeff,i)+offs)/divi *) @@ -331,6 +332,12 @@ struct let constant = List.fold_left accumulate_constants (Z.zero,Z.one) monomiallist in (* abstract simplification of the guard wrt. reference variables *) Some (Array.fold_lefti (fun list v (c) -> if Q.equal c Q.zero then list else (c.num,v,c.den)::list) [] expr, constant) ) + let simplified_monomials_from_texp (t: t) texp = + let res = simplified_monomials_from_texp t texp in + if M.tracing then M.tracel "from_texp" "%s %s -> %s" (EConj.show @@ snd @@ BatOption.get t.d) (Format.asprintf "%a" Texpr1.print_expr texp) + (BatOption.map_default (fun (l,(o,d)) -> List.fold_right (fun (a,x,b) acc -> Printf.sprintf "%s*var_%d/%s + %s" (Z.to_string a) x (Z.to_string b) acc) l ((Z.to_string o)^"/"^(Z.to_string d))) "" res); + res + let simplify_to_ref_and_offset (t: t) texp = BatOption.bind (simplified_monomials_from_texp t texp ) (fun (sum_of_terms, (constant,divisor)) -> @@ -403,15 +410,22 @@ struct (** is_top returns true for top_of array and empty array; precondition: t.env and t.d are of same size *) let is_top t = Environment.equal empty_env t.env && GobOption.exists EConj.is_top_con t.d + let to_subscript i = + let transl = [|"₀";"₁";"₂";"₃";"₄";"₅";"₆";"₇";"₈";"₉"|] in + let rec subscr i = + if i = 0 then "" + else (subscr (i/10)) ^ transl.(i mod 10) in + subscr i + + let show_var env i = + let transl = [|"₀";"₁";"₂";"₃";"₄";"₅";"₆";"₇";"₈";"₉"|] in + let res = Var.to_string (Environment.var_of_dim env i) in + match String.split_on_char '#' res with + | varname::rest::[] -> varname ^ (try String.fold_left (fun acc c -> acc ^ transl.(Char.code c - Char.code '0')) "" rest with _ -> "#"^rest) + | _ -> failwith "Variable name not found" + (** prints the current variable equalities with resolved variable names *) let show varM = - let lookup i = - let transl = [|"₀";"₁";"₂";"₃";"₄";"₅";"₆";"₇";"₈";"₉"|] in - let res = Var.to_string (Environment.var_of_dim varM.env i) in - match String.split_on_char '#' res with - | varname::rest::[] -> varname ^ (try String.fold_left (fun acc c -> acc ^ transl.(Char.code c - Char.code '0')) "" rest with _ -> "#"^rest) - | _ -> failwith "Variable name not found" - in match varM.d with | None -> "⊥\n" | Some arr when EConj.is_top_con arr -> "⊤\n" @@ -419,7 +433,7 @@ struct if is_bot varM then "Bot \n" else - EConj.show_formatted lookup (snd arr) ^ (" with dimension " ^ (string_of_int @@ fst arr)) + EConj.show_formatted (show_var varM.env) (snd arr) ^ (to_subscript @@ fst arr) let pretty () (x:t) = text (show x) let printXml f x = BatPrintf.fprintf f "\n\n\nequalities\n\n\n%s\n\nenv\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) (XmlUtil.escape (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (x.env))) @@ -437,7 +451,7 @@ struct let meet_with_one_conj t i e = let res = meet_with_one_conj t i e in - if M.tracing then M.trace "meet" "meet_with_one_conj %s with var_%d=%s -> %s" (show t) i (Rhs.show e) (show res); + if M.tracing then M.trace "meet" "%s with single eq %s=%s -> %s" (show t) (show_var t.env i) (Rhs.show_rhs_formatted (show_var t.env) e) (show res); res let meet t1 t2 = @@ -517,7 +531,7 @@ struct in let iterate map l = match l with - | (idx_h, _, _, rhs_h, _) :: t -> List.fold (fun acc e -> modify acc idx_h rhs_h e) map l + | (idx_h, _, _, rhs_h, _) :: t -> List.fold (fun acc e -> modify acc idx_h rhs_h e) map l | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) @@ -717,7 +731,7 @@ struct end | [(coeff, index, divi)] -> (* guard has a single reference variable only *) if Tcons1.get_typ tcons = EQ then - meet_with_one_conj t index (Rhs.canonicalize (None, Z.(divi*constant),Z.(coeff*divisor))) + meet_with_one_conj t index (Rhs.canonicalize (None, Z.neg @@ Z.(divi*constant),Z.(coeff*divisor))) else t (* only EQ is supported in equality based domains *) | [(c1,var1,d1); (c2,var2,d2)] -> (* two variables in relation needs a little sorting out *) From c6928c58a426674077bd38a5a02149edefc89745 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 22 May 2024 15:10:02 +0200 Subject: [PATCH 018/107] do not enforce pattern on variable names --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index d51bebb332..60e8f50d9d 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -422,7 +422,7 @@ struct let res = Var.to_string (Environment.var_of_dim env i) in match String.split_on_char '#' res with | varname::rest::[] -> varname ^ (try String.fold_left (fun acc c -> acc ^ transl.(Char.code c - Char.code '0')) "" rest with _ -> "#"^rest) - | _ -> failwith "Variable name not found" + | _ -> res (** prints the current variable equalities with resolved variable names *) let show varM = From ada7065af6bd9c276a0de59e96822bdf0ff4e504 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Wed, 22 May 2024 22:44:09 +0200 Subject: [PATCH 019/107] migration to appendix A - join (part 1) --- .../apron/linearTwoVarEqualityDomain.apron.ml | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 60e8f50d9d..8f9694de2c 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -503,7 +503,21 @@ struct - rhs1 - rhs2 however, we have to account for the sparseity of EConj maps by manually patching holes with default values *) - let joinfunction lhs rhs1 rhs2 = let coeff = Option.map_default fst Z.one in match rhs1, rhs2 with + let joinfunction lhs rhs1 rhs2 = + let pairing = match rhs1,rhs2 with (* first of all re-instantiate implicit sparse elements *) + | Some a, Some b -> Some (a,b) + | None, Some b -> Some (Rhs.var_zero lhs,b) + | Some a, None -> Some (a,Rhs.var_zero lhs) + | _ -> None + in let _= BatOption.map (function + | (Some (c1,var1),o1,d1) as r1 ,(Some (c2,var2),o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 + | (None, o1,d1) as r1, (Some (c2,var2),o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 + | (Some (c1,var1),o1,d1) as r1, (None ,o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 + | (None, o1,d1) as r1, (None ,o2,d2) as r2 -> + let magicnumber=Z.((o1/d1)-(o2/d2)) in + lhs, Q.make Z.(o1/magicnumber) Z.one,Q.make Z.(o1 mod magicnumber) Z.one,r1, r2 + ) pairing in () ; + let coeff = Option.map_default fst Z.one in match rhs1, rhs2 with (* Compute Ax+B such that (coeff1*(Ax+B)+off1)/d1 = (coeff2*x+off2)/d2 *) (* ====> A = (coeff2*d1)/(coeff1*d2) /\ B = (off2*d1-off1*d2)/(c1*c2) *) (* lhs A B rhs1 rhs2 *) From 366b04c2e2244276fde4963089da372c26439451 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 22 May 2024 15:39:15 +0200 Subject: [PATCH 020/107] error in tracing --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 8f9694de2c..e953a420a4 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -239,7 +239,7 @@ module EqualitiesConjunction = struct let (_,newh1)= inverse i (coeff1,h1,o1,divi1) in let newh1 = Rhs.subst normalizedj j (Rhs.subst (Some(coeff,j),offs,divi) i newh1) in subst_var ts h1 newh1)) in - if M.tracing then M.trace "meet_with_one_conj" "meet_with_one_conj conj: %s eq: var_%d=%s -> %s " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd ts)) + if M.tracing then M.trace "meet_with_one_conj" "meet_with_one_conj conj: %s eq: var_%d=%s -> %s " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd res)) ; res (** affine transform variable i allover conj with transformer (Some (coeff,i)+offs)/divi *) @@ -451,7 +451,7 @@ struct let meet_with_one_conj t i e = let res = meet_with_one_conj t i e in - if M.tracing then M.trace "meet" "%s with single eq %s=%s -> %s" (show t) (show_var t.env i) (Rhs.show_rhs_formatted (show_var t.env) e) (show res); + if M.tracing then M.tracel "meet" "%s with single eq %s=%s -> %s" (show t) (Z.(to_string @@ Tuple3.third e)^ show_var t.env i) (Rhs.show_rhs_formatted (show_var t.env) e) (show res); res let meet t1 t2 = From cb3b486b680ceff271afc0afda68a9b639bfb01d Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Thu, 23 May 2024 09:19:21 +0200 Subject: [PATCH 021/107] join of two different constants still remains in one equivalence class --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index e953a420a4..a5d27fec39 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -343,7 +343,7 @@ struct (fun (sum_of_terms, (constant,divisor)) -> (match sum_of_terms with | [] -> Some (None, constant,divisor) - | [(coeff,var,divi)] when Z.equal coeff Z.one -> Some (Rhs.canonicalize (Some (Z.mul divisor coeff,var), Z.mul constant divi,Z.mul divisor divi)) + | [(coeff,var,divi)] -> Some (Rhs.canonicalize (Some (Z.mul divisor coeff,var), Z.mul constant divi,Z.mul divisor divi)) |_ -> None)) let simplify_to_ref_and_offset t texp = timing_wrap "coeff_vec" (simplify_to_ref_and_offset t) texp @@ -514,8 +514,7 @@ struct | (None, o1,d1) as r1, (Some (c2,var2),o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 | (Some (c1,var1),o1,d1) as r1, (None ,o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 | (None, o1,d1) as r1, (None ,o2,d2) as r2 -> - let magicnumber=Z.((o1/d1)-(o2/d2)) in - lhs, Q.make Z.(o1/magicnumber) Z.one,Q.make Z.(o1 mod magicnumber) Z.one,r1, r2 + lhs, Q.make Z.((o1*d2)-(o2*d1)) Z.(d1*d2), Q.zero, r1, r2 ) pairing in () ; let coeff = Option.map_default fst Z.one in match rhs1, rhs2 with (* Compute Ax+B such that (coeff1*(Ax+B)+off1)/d1 = (coeff2*x+off2)/d2 *) @@ -543,9 +542,9 @@ struct let coeff1 = Option.map_default fst Z.one monom1 in (Some (Z.(coeff1*divi),x), Z.((z1*refcoeff)-(offs*coeff1)), Z.(refcoeff*d1)) ) in - let iterate map l = + let iterate map l = match l with - | (idx_h, _, _, rhs_h, _) :: t -> List.fold (fun acc e -> modify acc idx_h rhs_h e) map l + | (idx_h, a, b, rhs_h, _) :: t -> M.trace "join" " join me in dept %s %s" (Q.to_string a) (Q.to_string b); List.fold (fun acc e -> modify acc idx_h rhs_h e) map l | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From 58c4e7dc08079b10fbe553b69e359485dfc4f930 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Thu, 23 May 2024 10:33:52 +0200 Subject: [PATCH 022/107] made join criteria much more legible --- .../apron/linearTwoVarEqualityDomain.apron.ml | 37 +++++++------------ 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index a5d27fec39..ff4d19414f 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -499,32 +499,23 @@ struct (* joinfunction handles the dirty details of performing an "inner join" on the lhs of both bindings; in the resulting binding, the lhs is then mapped to values that are later relevant for sorting/grouping, i.e. - lhs itself - - the affine transformation from refvar1 to refvar2, i.E. the parameters A and B of the general affine transformer Ax+B + - criteria A and B that characterize equivalence class, depending on the reference variable and the affine expression parameters wrt. each EConj - rhs1 - rhs2 however, we have to account for the sparseity of EConj maps by manually patching holes with default values *) let joinfunction lhs rhs1 rhs2 = - let pairing = match rhs1,rhs2 with (* first of all re-instantiate implicit sparse elements *) - | Some a, Some b -> Some (a,b) - | None, Some b -> Some (Rhs.var_zero lhs,b) - | Some a, None -> Some (a,Rhs.var_zero lhs) - | _ -> None - in let _= BatOption.map (function - | (Some (c1,var1),o1,d1) as r1 ,(Some (c2,var2),o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 - | (None, o1,d1) as r1, (Some (c2,var2),o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 - | (Some (c1,var1),o1,d1) as r1, (None ,o2,d2) as r2 -> lhs, Q.one, Q.one, r1, r2 - | (None, o1,d1) as r1, (None ,o2,d2) as r2 -> - lhs, Q.make Z.((o1*d2)-(o2*d1)) Z.(d1*d2), Q.zero, r1, r2 - ) pairing in () ; - let coeff = Option.map_default fst Z.one in match rhs1, rhs2 with - (* Compute Ax+B such that (coeff1*(Ax+B)+off1)/d1 = (coeff2*x+off2)/d2 *) - (* ====> A = (coeff2*d1)/(coeff1*d2) /\ B = (off2*d1-off1*d2)/(c1*c2) *) - (* lhs A B rhs1 rhs2 *) - (*TODO*: if this works, make it more concise *) - | Some (ai,aj,ak), Some (bi,bj,bk) -> Some (lhs,Q.make Z.(ak*coeff bi) Z.(bk* coeff ai),Q.make Z.(bj*ak-aj*bk) Z.(bk*coeff ai), (ai,aj,ak) , (bi,bj,bk)) (* this is explicitely what we want *) - | None , Some (bi,bj,bk) -> Some (lhs,Q.make Z.( coeff bi) Z.(bk ),Q.make Z.(bj ) Z.(bk ), Rhs.var_zero lhs, (bi,bj,bk)) (* account for the sparseity of binding 1 *) - | Some (ai,aj,ak), None -> Some (lhs,Q.make Z.(ak ) Z.( coeff ai),Q.make Z.( neg aj) Z.( coeff ai), (ai,aj,ak), Rhs.var_zero lhs) (* account for the sparseity of binding 2 *) - | _,_ -> None (* no binding for lhs in both maps is replicated implicitely in a sparse result map *) + (match rhs1,rhs2 with (* first of all re-instantiate implicit sparse elements *) + | Some a, Some b -> Some (a,b) + | None, Some b -> Some (Rhs.var_zero lhs,b) + | Some a, None -> Some (a,Rhs.var_zero lhs) + | _ -> None) + |> + BatOption.map (fun (r1,r2) -> match (r1,r2) with (* criterion A , criterion B *) + | (Some (c1,_),o1,d1), (Some (c2,_),o2,d2)-> lhs, Q.make Z.((o1*d2)-(o2*d1)) Z.(c1*d2), Q.make Z.(c2*d2) Z.(c1*d1), r1, r2 + | (None, oc,dc), (Some (cv,_),ov,dv) + | (Some (cv,_),ov,dv), (None ,oc,dc)-> lhs, Q.make Z.((oc*dv)-(ov*dc)) Z.(dc*cv), Q.one , r1, r2 (* equivalence class defined by (oc/dc-ov/dv)/(cv/dv) *) + | (None, o1,d1), (None ,o2,d2)-> lhs, (if Z.(zero = ((o1*d2)-(o2*d1))) then Q.one else Q.zero), Q.zero, r1, r2 (* only two equivalence classes: constants with matching values or constants with different values *) + ) in let table = List.of_enum @@ EConj.IntMap.values @@ EConj.IntMap.merge joinfunction (snd ad) (snd bd) in (* compare two variables for grouping depending on affine function parameters a, b and reference variable indices *) @@ -544,7 +535,7 @@ struct in let iterate map l = match l with - | (idx_h, a, b, rhs_h, _) :: t -> M.trace "join" " join me in dept %s %s" (Q.to_string a) (Q.to_string b); List.fold (fun acc e -> modify acc idx_h rhs_h e) map l + | (idx_h, a, b, rhs_h, _) :: t -> M.trace "join" " iterate through equivalence group with a=%s and b=%s" (Q.to_string a) (Q.to_string b); List.fold (fun acc e -> modify acc idx_h rhs_h e) map l | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From b5fed0874204e5f12e90eceaa23601653c35dae8 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Thu, 23 May 2024 16:32:21 +0200 Subject: [PATCH 023/107] added case distinction for equivalence classes --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index ff4d19414f..e49b3a0f93 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -535,7 +535,11 @@ struct in let iterate map l = match l with - | (idx_h, a, b, rhs_h, _) :: t -> M.trace "join" " iterate through equivalence group with a=%s and b=%s" (Q.to_string a) (Q.to_string b); List.fold (fun acc e -> modify acc idx_h rhs_h e) map l + | (x, a, b, ((Some _,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> M.trace "join" "handle var-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((Some _,_,_) as rhs), ((None,_,_) as rhs')) :: t -> M.trace "join" "handle var-const equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((None,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> M.trace "join" "handle const-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((None,o1,d1) as rhs), ((None,o2,d2) )) :: t when (o1,d1)=(o2,d2) -> M.trace "join" "handle const-const equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((None,_,_) as rhs), ((None,_,_) as rhs')) :: t -> M.trace "join" "handle const1-const2 equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From 083d1ea88a95cf0277ae8cbfeff07c658ff4b83c Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Thu, 23 May 2024 20:13:37 +0200 Subject: [PATCH 024/107] satisfy semgrep --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index e49b3a0f93..89cead570b 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -535,11 +535,11 @@ struct in let iterate map l = match l with - | (x, a, b, ((Some _,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> M.trace "join" "handle var-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((Some _,_,_) as rhs), ((None,_,_) as rhs')) :: t -> M.trace "join" "handle var-const equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((None,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> M.trace "join" "handle const-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((None,o1,d1) as rhs), ((None,o2,d2) )) :: t when (o1,d1)=(o2,d2) -> M.trace "join" "handle const-const equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((None,_,_) as rhs), ((None,_,_) as rhs')) :: t -> M.trace "join" "handle const1-const2 equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((Some _,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle var-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((Some _,_,_) as rhs), ((None,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle var-const equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((None,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle const-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((None,o1,d1) as rhs), ((None,o2,d2) )) :: t when (o1,d1)=(o2,d2) -> if M.tracing then M.trace "join" "handle const-const equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l + | (x, a, b, ((None,_,_) as rhs), ((None,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle const1-const2 equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From c6336515f17183f95e9dfc8a20e225067f94cc06 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Thu, 23 May 2024 22:13:41 +0200 Subject: [PATCH 025/107] join carried out for const cases --- .../apron/linearTwoVarEqualityDomain.apron.ml | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 89cead570b..6967d0371d 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -525,21 +525,21 @@ struct in (* Calculate new components as groups *) let new_components = BatList.group cmp_z table in - (* Adjust the domain map to represent the new components *) - let modify map x (refmonom, offs, divi) (idx, _, _, (monom1, z1, d1), (monom2, z2, d2)) = EConj.set_rhs map (idx) - (if monom1 = monom2 && Z.equal z1 z2 && Z.equal d1 d2 then (monom1, z1, d1) - else - let refcoeff = Option.map_default fst Z.one refmonom in - let coeff1 = Option.map_default fst Z.one monom1 in - (Some (Z.(coeff1*divi),x), Z.((z1*refcoeff)-(offs*coeff1)), Z.(refcoeff*d1)) ) - in + + (* ci1 = a*ch1+b /\ ci2 = a*ch2+b *) + (* ===> a = (ci1-ci2)/(ch1-ch2) b = ci2-a*ch2 *) + let constentry ci1 ci2 ch1 ch2 xh = + let a = Q.((ci1-ci2) / (ch1-ch2)) in + let b= Q.(ci2 - a*ch2) in + let anum=a.num and aden=a.den and bnum=b.num and bden=b.den in + Rhs.canonicalize (Some (Z.(anum*bden),xh),Z.(bnum*aden) ,Z.(aden*bden) ) in let iterate map l = match l with - | (x, a, b, ((Some _,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle var-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((Some _,_,_) as rhs), ((None,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle var-const equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((None,_,_) as rhs), ((Some _,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle const-var equivalence group"; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((None,o1,d1) as rhs), ((None,o2,d2) )) :: t when (o1,d1)=(o2,d2) -> if M.tracing then M.trace "join" "handle const-const equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l - | (x, a, b, ((None,_,_) as rhs), ((None,_,_) as rhs')) :: t -> if M.tracing then M.trace "join" "handle const1-const2 equivalence group" ; List.fold (fun acc e -> modify acc x rhs e) map l + | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> if M.tracing then M.trace "join" "handle var-var class"; List.fold (fun acc e -> acc) map t + | (h, _, _, ((Some (ch,_),oh,dh)), ((None,_,_) )) :: t -> if M.tracing then M.trace "join" "handle var-const class"; List.fold (fun acc e -> acc) map t + | (h, _, _, ((None,_,_) ), ((Some (ch,_),oh,dh))) :: t -> if M.tracing then M.trace "join" "handle const-var class"; List.fold (fun acc e -> acc) map t + | (_, _, _, rhs , rhs' ) :: t when rhs=rhs' -> if M.tracing then M.trace "join" "handle const-const class" ; List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l + | (h, _, _, ((None,oh1,dh1) ), ((None),oh2,dh2) ) :: t -> if M.tracing then M.trace "join" "handle const1-const2 class" ; List.fold (fun acc (i,_,_,(_,oi1,di1),(_,oi2,di2)) -> EConj.set_rhs acc i (constentry Q.(make oi1 di1) Q.(make oi2 di2) (Q.make oh1 dh1) (Q.make oh2 dh2) h)) map t | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From 9e4cd5892b9ba8f9ed1d0c97e4d16586b7bdfcc8 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 09:53:34 +0200 Subject: [PATCH 026/107] migration to appendix A - join (part 2) --- .../apron/linearTwoVarEqualityDomain.apron.ml | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 6967d0371d..2e3b473fcc 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -525,21 +525,25 @@ struct in (* Calculate new components as groups *) let new_components = BatList.group cmp_z table in - + let varentry ci offi ch offh xh = + let (coeff,off,d) = Q.(ci,(offi*ch)-(ci*offh),ch) in (* compute new rhs in Q *) + let (coeff,off,d) = Z.(coeff.num*d.den*off.den,off.num*d.den*coeff.den,d. num*coeff.den*off.den) in (* convert that back into Z *) + Rhs.canonicalize (Some(coeff,xh),off,d) + in (* ci1 = a*ch1+b /\ ci2 = a*ch2+b *) (* ===> a = (ci1-ci2)/(ch1-ch2) b = ci2-a*ch2 *) let constentry ci1 ci2 ch1 ch2 xh = let a = Q.((ci1-ci2) / (ch1-ch2)) in - let b= Q.(ci2 - a*ch2) in + let b = Q.(ci2 - a*ch2) in let anum=a.num and aden=a.den and bnum=b.num and bden=b.den in Rhs.canonicalize (Some (Z.(anum*bden),xh),Z.(bnum*aden) ,Z.(aden*bden) ) in let iterate map l = match l with - | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> if M.tracing then M.trace "join" "handle var-var class"; List.fold (fun acc e -> acc) map t - | (h, _, _, ((Some (ch,_),oh,dh)), ((None,_,_) )) :: t -> if M.tracing then M.trace "join" "handle var-const class"; List.fold (fun acc e -> acc) map t - | (h, _, _, ((None,_,_) ), ((Some (ch,_),oh,dh))) :: t -> if M.tracing then M.trace "join" "handle const-var class"; List.fold (fun acc e -> acc) map t - | (_, _, _, rhs , rhs' ) :: t when rhs=rhs' -> if M.tracing then M.trace "join" "handle const-const class" ; List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l - | (h, _, _, ((None,oh1,dh1) ), ((None),oh2,dh2) ) :: t -> if M.tracing then M.trace "join" "handle const1-const2 class" ; List.fold (fun acc (i,_,_,(_,oi1,di1),(_,oi2,di2)) -> EConj.set_rhs acc i (constentry Q.(make oi1 di1) Q.(make oi2 di2) (Q.make oh1 dh1) (Q.make oh2 dh2) h)) map t + | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> List.fold (fun acc (i,_,_,(Some (ci,_),oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t + | (h, _, _, ((Some (ch,_),oh,dh)), ((None,_,_) )) :: t -> List.fold (fun acc (i,_,_,(Some (ci,_),oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t + | (h, _, _, ((None,_,_) ), ((Some (ch,_),oh,dh))) :: t -> List.fold (fun acc (i,_,_,_,(Some (ci,_),oi,di)) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t + | (_, _, _, rhs , rhs' ) :: t when rhs=rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l + | (h, _, _, ((None,oh1,dh1) ), ((None),oh2,dh2) ) :: t -> List.fold (fun acc (i,_,_,(_,oi1,di1),(_,oi2,di2)) -> EConj.set_rhs acc i (constentry Q.(make oi1 di1) Q.(make oi2 di2) Q.(make oh1 dh1) Q.(make oh2 dh2) h)) map t | [] -> let exception EmptyComponent in raise EmptyComponent in Some (List.fold iterate (EConj.make_empty_conj @@ fst ad) new_components) From e290d3c2556fc91ec4a5f3371c65f8e2d23b5036 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 10:07:28 +0200 Subject: [PATCH 027/107] added regression test for coefficient-heavy transactions --- .../77-lin2vareq/34-coefficient-features.c | 69 +++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100644 tests/regression/77-lin2vareq/34-coefficient-features.c diff --git a/tests/regression/77-lin2vareq/34-coefficient-features.c b/tests/regression/77-lin2vareq/34-coefficient-features.c new file mode 100644 index 0000000000..4a0469a40d --- /dev/null +++ b/tests/regression/77-lin2vareq/34-coefficient-features.c @@ -0,0 +1,69 @@ +//SKIP PARAM: --set ana.activated[+] lin2vareq --set sem.int.signed_overflow assume_none +// this test checks basic coefficient handing in main and join capabilities in loop + +#include + +void loop() { + int random; + int i = 0; + int x = 0; + int y = 0; + + x=x+4; + y=y+8; + i=i+1; + + if (random) { + x=x+4; + y=y+8; + i=i+1; + } + + __goblint_check(x == 4*i); //SUCCESS + + for(i = 1; i < 100; i++) { + x=x+4; + y=y+8; + + __goblint_check(y == 2*x); //SUCCESS + } + + x=0; + y=0; + + for(i = 1; i < 100; i++) { + x=x+4; + y=y+8; + + __goblint_check(y == 2*x); //SUCCESS + __goblint_check(x == 4*i); //SUCCESS + } +} + +void main() { + int a; + int b; + int c; + int unknown; + a = 4; + + b = 4*c; + + __goblint_check(b == 4*c); //SUCCESS + + b = a*c; + + __goblint_check(b == 4*c); //SUCCESS + + if (5*b == 20*unknown + a){ + + __goblint_check(5*b == 20*unknown + a); //SUCCESS + } + + b = unknown ? a*c : 4*c; + + __goblint_check(b == 4*c); //SUCCESS + + loop(); + +} \ No newline at end of file From 9de6f858fcdf8526208e5041aba22036517365ee Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 10:59:26 +0200 Subject: [PATCH 028/107] make coefficents in regression coprime, and flex with propagation of 2var relations --- tests/regression/77-lin2vareq/34-coefficient-features.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/regression/77-lin2vareq/34-coefficient-features.c b/tests/regression/77-lin2vareq/34-coefficient-features.c index 4a0469a40d..b415f4398a 100644 --- a/tests/regression/77-lin2vareq/34-coefficient-features.c +++ b/tests/regression/77-lin2vareq/34-coefficient-features.c @@ -26,6 +26,10 @@ void loop() { y=y+8; __goblint_check(y == 2*x); //SUCCESS + + int res = (y==2*x )+ 1; + + __goblint_check(res); //SUCCESS } x=0; @@ -55,9 +59,9 @@ void main() { __goblint_check(b == 4*c); //SUCCESS - if (5*b == 20*unknown + a){ + if (7*b == 20*unknown + a){ - __goblint_check(5*b == 20*unknown + a); //SUCCESS + __goblint_check(7*b == 20*unknown + a); //SUCCESS } b = unknown ? a*c : 4*c; From 3291633f1a1dde4fff71751ac567f5986b05d0e1 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 11:00:06 +0200 Subject: [PATCH 029/107] wave through var-var equivalences if var1=var2 --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 2e3b473fcc..8dc4a71e90 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -539,10 +539,10 @@ struct Rhs.canonicalize (Some (Z.(anum*bden),xh),Z.(bnum*aden) ,Z.(aden*bden) ) in let iterate map l = match l with + | (_, _, _, rhs , rhs' ) :: t when rhs=rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> List.fold (fun acc (i,_,_,(Some (ci,_),oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t | (h, _, _, ((Some (ch,_),oh,dh)), ((None,_,_) )) :: t -> List.fold (fun acc (i,_,_,(Some (ci,_),oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t | (h, _, _, ((None,_,_) ), ((Some (ch,_),oh,dh))) :: t -> List.fold (fun acc (i,_,_,_,(Some (ci,_),oi,di)) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t - | (_, _, _, rhs , rhs' ) :: t when rhs=rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l | (h, _, _, ((None,oh1,dh1) ), ((None),oh2,dh2) ) :: t -> List.fold (fun acc (i,_,_,(_,oi1,di1),(_,oi2,di2)) -> EConj.set_rhs acc i (constentry Q.(make oi1 di1) Q.(make oi2 di2) Q.(make oh1 dh1) Q.(make oh2 dh2) h)) map t | [] -> let exception EmptyComponent in raise EmptyComponent in From 83d7fb8f263a64b71e10872ae5691d56e08ee327 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 11:05:21 +0200 Subject: [PATCH 030/107] removed warning 8 --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 8dc4a71e90..9d744ad926 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -540,9 +540,9 @@ struct let iterate map l = match l with | (_, _, _, rhs , rhs' ) :: t when rhs=rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l - | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> List.fold (fun acc (i,_,_,(Some (ci,_),oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t - | (h, _, _, ((Some (ch,_),oh,dh)), ((None,_,_) )) :: t -> List.fold (fun acc (i,_,_,(Some (ci,_),oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t - | (h, _, _, ((None,_,_) ), ((Some (ch,_),oh,dh))) :: t -> List.fold (fun acc (i,_,_,_,(Some (ci,_),oi,di)) -> EConj.set_rhs acc i (varentry Q.(make ci di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t + | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> List.fold (fun acc (i,_,_,(monom,oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t + | (h, _, _, ((Some (ch,_),oh,dh)), ((None,_,_) )) :: t -> List.fold (fun acc (i,_,_,(monom,oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t + | (h, _, _, ((None,_,_) ), ((Some (ch,_),oh,dh))) :: t -> List.fold (fun acc (i,_,_,_,(monom,oi,di)) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t | (h, _, _, ((None,oh1,dh1) ), ((None),oh2,dh2) ) :: t -> List.fold (fun acc (i,_,_,(_,oi1,di1),(_,oi2,di2)) -> EConj.set_rhs acc i (constentry Q.(make oi1 di1) Q.(make oi2 di2) Q.(make oh1 dh1) Q.(make oh2 dh2) h)) map t | [] -> let exception EmptyComponent in raise EmptyComponent in From 16c8e6567a09836a684e56c0a3fcd8a5a55a0933 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 13:25:47 +0200 Subject: [PATCH 031/107] got rid of unnecessarily largearray --- .../apron/linearTwoVarEqualityDomain.apron.ml | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 9d744ad926..d3beadbb9f 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -290,7 +290,6 @@ struct in let rec convert_texpr texp = begin match texp with - (* If x is a constant, replace it with its const. val. immediately *) | Cst (Interval _) -> failwith "constant was an interval; this is not supported" | Cst (Scalar x) -> begin match SharedFunctions.int_of_scalar ?round:None x with @@ -322,15 +321,15 @@ struct BatOption.bind (monomials_from_texp t texp) (fun monomiallist -> let d = Option.get t.d in - let expr = Array.make (Environment.size t.env) (Q.zero) in (*TODO*: migrate to map; array of coeff/divisor per var idx*) - let accumulate_constants (aconst,adiv) (v,offs,divi) = match v with - | None -> let gcdee = Z.gcd adiv divi in (Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi) + let accumulate_constants (exprcache,(aconst,adiv)) (v,offs,divi) = match v with + | None -> let gcdee = Z.gcd adiv divi in exprcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi) | Some (coeff,idx) -> let (somevar,someoffs,somedivi)=Rhs.subst (EConj.get_rhs d idx) idx (v,offs,divi) in (* normalize! *) - (Option.may (fun (coef,ter) -> expr.(ter) <- Q.(expr.(ter) + Q.make coef somedivi)) somevar; - let gcdee = Z.gcd adiv divi in (Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi)) + let newcache = Option.map_default (fun (coef,ter) -> EConj.IntMap.add ter Q.((EConj.IntMap.find_default zero ter exprcache) + make coef somedivi) exprcache) exprcache somevar in + let gcdee = Z.gcd adiv divi in + (newcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi)) in - let constant = List.fold_left accumulate_constants (Z.zero,Z.one) monomiallist in (* abstract simplification of the guard wrt. reference variables *) - Some (Array.fold_lefti (fun list v (c) -> if Q.equal c Q.zero then list else (c.num,v,c.den)::list) [] expr, constant) ) + let (expr,constant) = List.fold_left accumulate_constants (EConj.IntMap.empty,(Z.zero,Z.one)) monomiallist in (* abstract simplification of the guard wrt. reference variables *) + Some (EConj.IntMap.fold (fun v c acc -> if Q.equal c Q.zero then acc else (Q.num c,v,Q.den c)::acc) expr [], constant) ) let simplified_monomials_from_texp (t: t) texp = let res = simplified_monomials_from_texp t texp in @@ -348,7 +347,6 @@ struct let simplify_to_ref_and_offset t texp = timing_wrap "coeff_vec" (simplify_to_ref_and_offset t) texp - (* Copy because function is not "with" so should not mutate inputs *) let assign_const t var const divi = match t.d with | None -> t | Some t_d -> {d = Some (EConj.set_rhs t_d var (None, const, divi)); env = t.env} From aded7d59eaa7153134b6f71ed89aae85e9eea893 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 14:03:46 +0200 Subject: [PATCH 032/107] rm redundancies --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index d3beadbb9f..5bd68cc858 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -416,10 +416,9 @@ struct subscr i let show_var env i = - let transl = [|"₀";"₁";"₂";"₃";"₄";"₅";"₆";"₇";"₈";"₉"|] in let res = Var.to_string (Environment.var_of_dim env i) in match String.split_on_char '#' res with - | varname::rest::[] -> varname ^ (try String.fold_left (fun acc c -> acc ^ transl.(Char.code c - Char.code '0')) "" rest with _ -> "#"^rest) + | varname::rest::[] -> varname ^ (try to_subscript @@ int_of_string rest with _ -> "#" ^ rest) | _ -> res (** prints the current variable equalities with resolved variable names *) From 26419aa1bd1645cbb766be67464f60b7c2e73610 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Fri, 24 May 2024 15:30:28 +0200 Subject: [PATCH 033/107] Update src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml make repopulation of the sparse conjunction more concise Co-authored-by: Michael Schwarz --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 5bd68cc858..d73d9cf783 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -501,11 +501,11 @@ struct - rhs2 however, we have to account for the sparseity of EConj maps by manually patching holes with default values *) let joinfunction lhs rhs1 rhs2 = - (match rhs1,rhs2 with (* first of all re-instantiate implicit sparse elements *) - | Some a, Some b -> Some (a,b) - | None, Some b -> Some (Rhs.var_zero lhs,b) - | Some a, None -> Some (a,Rhs.var_zero lhs) - | _ -> None) + ( + let e = Option.default (Rhs.var_zero lhs) in + match rhs1,rhs2 with (* first of all re-instantiate implicit sparse elements *) + | None, None -> None + | a, b -> Some (e a, e b)) |> BatOption.map (fun (r1,r2) -> match (r1,r2) with (* criterion A , criterion B *) | (Some (c1,_),o1,d1), (Some (c2,_),o2,d2)-> lhs, Q.make Z.((o1*d2)-(o2*d1)) Z.(c1*d2), Q.make Z.(c2*d2) Z.(c1*d1), r1, r2 From 49895fe04666fdfa4a82d3a7323c7692931ccbfd Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 15:25:25 +0200 Subject: [PATCH 034/107] replace = with more specialized Rhs.equal --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index d73d9cf783..b2beb9fab9 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -536,7 +536,7 @@ struct Rhs.canonicalize (Some (Z.(anum*bden),xh),Z.(bnum*aden) ,Z.(aden*bden) ) in let iterate map l = match l with - | (_, _, _, rhs , rhs' ) :: t when rhs=rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l + | (_, _, _, rhs , rhs' ) :: t when Rhs.equal rhs rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> List.fold (fun acc (i,_,_,(monom,oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t | (h, _, _, ((Some (ch,_),oh,dh)), ((None,_,_) )) :: t -> List.fold (fun acc (i,_,_,(monom,oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t | (h, _, _, ((None,_,_) ), ((Some (ch,_),oh,dh))) :: t -> List.fold (fun acc (i,_,_,_,(monom,oi,di)) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t From 7e2a741eedcb942c16720181ebd37f7d1a849cf3 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 15:27:52 +0200 Subject: [PATCH 035/107] gotten rid of silly record deconstruction --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index b2beb9fab9..090f31718e 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -532,8 +532,7 @@ struct let constentry ci1 ci2 ch1 ch2 xh = let a = Q.((ci1-ci2) / (ch1-ch2)) in let b = Q.(ci2 - a*ch2) in - let anum=a.num and aden=a.den and bnum=b.num and bden=b.den in - Rhs.canonicalize (Some (Z.(anum*bden),xh),Z.(bnum*aden) ,Z.(aden*bden) ) in + Rhs.canonicalize (Some (Z.(a.num*b.den),xh),Z.(b.num*a.den) ,Z.(a.den*b.den) ) in let iterate map l = match l with | (_, _, _, rhs , rhs' ) :: t when Rhs.equal rhs rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l From 62e569b0767332a8321d735f91b213977629171d Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 15:34:53 +0200 Subject: [PATCH 036/107] make indentation happy again --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 090f31718e..23ee5056be 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -504,8 +504,8 @@ struct ( let e = Option.default (Rhs.var_zero lhs) in match rhs1,rhs2 with (* first of all re-instantiate implicit sparse elements *) - | None, None -> None - | a, b -> Some (e a, e b)) + | None, None -> None + | a, b -> Some (e a, e b)) |> BatOption.map (fun (r1,r2) -> match (r1,r2) with (* criterion A , criterion B *) | (Some (c1,_),o1,d1), (Some (c2,_),o2,d2)-> lhs, Q.make Z.((o1*d2)-(o2*d1)) Z.(c1*d2), Q.make Z.(c2*d2) Z.(c1*d1), r1, r2 From 4810b5da346eb66ae59d59063a6961710b0138b4 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 15:39:19 +0200 Subject: [PATCH 037/107] make gcd more compact --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 23ee5056be..266f8e0505 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -38,10 +38,8 @@ module Rhs = struct (** factor out gcd from all terms, i.e. ax=by+c is the canonical form for adx+bdy+cd *) let canonicalize (v,o,d) = let gcd = Z.gcd o d in - let gcd = match v with - | Some (c,_) -> Z.gcd c gcd - | None -> gcd - in let gcd = if (Z.(lt d Z.zero)) then Z.neg gcd else gcd in + let gcd = Option.map_default (fun (c,_) -> Z.gcd c gcd) gcd v in + let gcd = if (Z.(lt d Z.zero)) then Z.neg gcd else gcd in (BatOption.map (fun (coeff,i) -> (Z.div coeff gcd,i)) v,Z.div o gcd, Z.div d gcd) (** Substitute rhs for varx in rhs' *) From 98ae9a4bb46b0976e9491b91f3bb2d50b6c0319a Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 15:49:00 +0200 Subject: [PATCH 038/107] explain canonicalization --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 266f8e0505..5aef1b1371 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -37,10 +37,10 @@ module Rhs = struct (** factor out gcd from all terms, i.e. ax=by+c is the canonical form for adx+bdy+cd *) let canonicalize (v,o,d) = - let gcd = Z.gcd o d in - let gcd = Option.map_default (fun (c,_) -> Z.gcd c gcd) gcd v in - let gcd = if (Z.(lt d Z.zero)) then Z.neg gcd else gcd in - (BatOption.map (fun (coeff,i) -> (Z.div coeff gcd,i)) v,Z.div o gcd, Z.div d gcd) + let gcd = Z.gcd o d in (* gcd of coefficients *) + let gcd = Option.map_default (fun (c,_) -> Z.gcd c gcd) gcd v in (* include monomial in gcd computation *) + let commondivisor = if Z.(lt d zero) then Z.neg gcd else gcd in (* cannonical form dictates d being positive *) + (BatOption.map (fun (coeff,i) -> (Z.div coeff commondivisor,i)) v,Z.div o commondivisor, Z.div d commondivisor) (** Substitute rhs for varx in rhs' *) let subst rhs varx rhs' = From 55c15f74bcffa6adc5d8360b1a9d88be1f7b0a31 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 24 May 2024 16:21:23 +0200 Subject: [PATCH 039/107] printf tuning --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 5aef1b1371..50fdf54d99 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -29,7 +29,7 @@ module Rhs = struct else (Z.to_string c) ^"·" let show_rhs_formatted formatter = function | (Some (coeff,v), o,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) - | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s%+Ld" (show_coeff coeff) (formatter v) (Z.to_int64 o) + | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s%+Lu" (show_coeff coeff) (formatter v) (Z.to_int64_unsigned o) | (None, o,_) -> Printf.sprintf "%Ld" (Z.to_int64 o) let show (v,o,d) = let rhs=show_rhs_formatted (Printf.sprintf "var_%d") (v,o,d) in From 9078c2a6e087e8ae7ef5bf30d2d01f6caee168da Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Sat, 25 May 2024 22:33:36 +0200 Subject: [PATCH 040/107] oversight of %+, so lets do it the affeq way --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 50fdf54d99..81ae290f66 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -27,9 +27,10 @@ module Rhs = struct if Z.equal c Z.one then "" else if Z.equal c Z.minus_one then "-" else (Z.to_string c) ^"·" - let show_rhs_formatted formatter = function + let show_rhs_formatted formatter = let ztostring n = if Z.(geq n zero) then "+" else "" ^ Z.to_string n in + function | (Some (coeff,v), o,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) - | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s%+Lu" (show_coeff coeff) (formatter v) (Z.to_int64_unsigned o) + | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s %s" (show_coeff coeff) (formatter v) (ztostring o) | (None, o,_) -> Printf.sprintf "%Ld" (Z.to_int64 o) let show (v,o,d) = let rhs=show_rhs_formatted (Printf.sprintf "var_%d") (v,o,d) in From e0e9c3436e8652df23476e177b22e6e507e9ab7e Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Sat, 25 May 2024 23:02:13 +0200 Subject: [PATCH 041/107] point out IMap has nothing directly to do with EConj --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 81ae290f66..f89a8d39ba 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -316,19 +316,20 @@ struct | x -> Some(x) (** convert and simplify (wrt. reference variables) a texpr into a tuple of a list of monomials (coeff,varidx,divi) and a (constant/divi) *) - let simplified_monomials_from_texp (t: t) texp = + let simplified_monomials_from_texp (t: t) texp = BatOption.bind (monomials_from_texp t texp) (fun monomiallist -> let d = Option.get t.d in + let module IMap = EConj.IntMap in let accumulate_constants (exprcache,(aconst,adiv)) (v,offs,divi) = match v with | None -> let gcdee = Z.gcd adiv divi in exprcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi) | Some (coeff,idx) -> let (somevar,someoffs,somedivi)=Rhs.subst (EConj.get_rhs d idx) idx (v,offs,divi) in (* normalize! *) - let newcache = Option.map_default (fun (coef,ter) -> EConj.IntMap.add ter Q.((EConj.IntMap.find_default zero ter exprcache) + make coef somedivi) exprcache) exprcache somevar in + let newcache = Option.map_default (fun (coef,ter) -> IMap.add ter Q.((IMap.find_default zero ter exprcache) + make coef somedivi) exprcache) exprcache somevar in let gcdee = Z.gcd adiv divi in (newcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi)) in - let (expr,constant) = List.fold_left accumulate_constants (EConj.IntMap.empty,(Z.zero,Z.one)) monomiallist in (* abstract simplification of the guard wrt. reference variables *) - Some (EConj.IntMap.fold (fun v c acc -> if Q.equal c Q.zero then acc else (Q.num c,v,Q.den c)::acc) expr [], constant) ) + let (expr,constant) = List.fold_left accumulate_constants (IMap.empty,(Z.zero,Z.one)) monomiallist in (* abstract simplification of the guard wrt. reference variables *) + Some (IMap.fold (fun v c acc -> if Q.equal c Q.zero then acc else (Q.num c,v,Q.den c)::acc) expr [], constant) ) let simplified_monomials_from_texp (t: t) texp = let res = simplified_monomials_from_texp t texp in From c6ec44bb6686c0123cfd819892fa15607a024cb2 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Sat, 25 May 2024 23:13:37 +0200 Subject: [PATCH 042/107] more concise subst --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index f89a8d39ba..87446a7b6b 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -46,8 +46,7 @@ module Rhs = struct (** Substitute rhs for varx in rhs' *) let subst rhs varx rhs' = match rhs,rhs' with - | (Some (c,x),o,d),(Some (c',x'),o',d') when x'=varx -> canonicalize (Some (Z.mul c c',x),Z.((o*c')+(d*o')),Z.mul d d') - | (None ,o,d),(Some (c',x'),o',d') when x'=varx -> canonicalize (None ,Z.((o*c')+(d*o')),Z.mul d d') + | (monom,o,d),(Some (c',x'),o',d') when x'=varx -> canonicalize (Option.map (fun (c,x) -> (Z.mul c c',x)) monom,Z.((o*c')+(d*o')),Z.mul d d') | _ -> rhs' end From 6f02c2ab45d901bc78eedf35908b1bc9f7dd71ce Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Sat, 25 May 2024 23:24:20 +0200 Subject: [PATCH 043/107] rm faulty eval_int answer --- .../apron/linearTwoVarEqualityDomain.apron.ml | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 87446a7b6b..99fc69a0a5 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -158,8 +158,8 @@ module EqualitiesConjunction = struct List.fold (fun map i -> let (oldref,c',a') = (get_rhs d i) in let (b',_) = BatOption.get oldref in - let newrhs = (Some (Z.(b'*a),head), Z.(c' - (b' * c)), Z.(a'*b)) in - canonicalize_and_set map i newrhs + (Some (Z.(b'*a),head), Z.(c' - (b' * c)), Z.(a'*b)) |> + canonicalize_and_set map i ) d cluster (* shift offset to match new reference variable *) | [] -> d) (* empty cluster means no work for us *) | _ -> d) (* variable is either a constant or expressed by another refvar *) in @@ -364,13 +364,6 @@ struct | Some (None, offset, divisor) when Z.equal (Z.rem offset divisor) Z.zero -> let res = Z.div offset divisor in (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string res) (IntOps.BigIntOps.to_string res); Some res, Some res) - | Some (None, offset, divisor) -> let res = Z.div offset divisor in - let (lower,upper) = if Z.lt res Z.zero then - (Z.pred res,res) - else - (res,Z.succ res) in - (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string lower) (IntOps.BigIntOps.to_string upper); - Some lower, Some upper) | _ -> None, None let bound_texpr d texpr1 = timing_wrap "bounds calculation" (bound_texpr d) texpr1 From 31bb80289111c688bbfc04cbf27a9965d1c43ca8 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Mon, 27 May 2024 16:11:30 +0200 Subject: [PATCH 044/107] rm Z.t->int conv issues --- src/cdomains/apron/gobApron.apron.ml | 7 +++++++ src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 6 +++--- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/cdomains/apron/gobApron.apron.ml b/src/cdomains/apron/gobApron.apron.ml index c39a3e42db..e202a88c60 100644 --- a/src/cdomains/apron/gobApron.apron.ml +++ b/src/cdomains/apron/gobApron.apron.ml @@ -1,6 +1,13 @@ open Batteries include Apron +module Coeff = +struct + include Coeff + + let s_of_z z = Coeff.s_of_mpqf (Mpqf.of_mpz (Z_mlgmpidl.mpz_of_z z)) +end + module Var = struct include Var diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 99fc69a0a5..08358005b4 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -31,7 +31,7 @@ module Rhs = struct function | (Some (coeff,v), o,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s %s" (show_coeff coeff) (formatter v) (ztostring o) - | (None, o,_) -> Printf.sprintf "%Ld" (Z.to_int64 o) + | (None, o,_) -> Printf.sprintf "%s" (Z.to_string o) let show (v,o,d) = let rhs=show_rhs_formatted (Printf.sprintf "var_%d") (v,o,d) in if not (Z.equal d Z.one) then "(" ^ rhs ^ ")/" ^ (Z.to_string d) else rhs @@ -798,12 +798,12 @@ struct let get_const acc i = function | (None, o, d) -> let xi = Environment.var_of_dim t.env i in - of_coeff xi [(Coeff.s_of_int (- (Z.to_int d)), xi)] o :: acc + of_coeff xi [(GobApron.Coeff.s_of_z @@ Z.neg d, xi)] o :: acc | (Some (c,r), _,_) when r = i -> acc | (Some (c,r), o, d) -> let xi = Environment.var_of_dim t.env i in let ri = Environment.var_of_dim t.env r in - of_coeff xi [(Coeff.s_of_int (- (Z.to_int d)), xi); (Coeff.s_of_int @@ Z.to_int c, ri)] o :: acc + of_coeff xi [(GobApron.Coeff.s_of_z @@ Z.neg d, xi); (GobApron.Coeff.s_of_z c, ri)] o :: acc in BatOption.get t.d |> fun (_,map) -> EConj.IntMap.fold (fun lhs rhs list -> get_const list lhs rhs) map [] From ec3deedeef7eba8f2e6f8f8d03c71cb1e500910e Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Tue, 28 May 2024 14:59:19 +0200 Subject: [PATCH 045/107] wrong brackets --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 08358005b4..0a110a5999 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -27,7 +27,7 @@ module Rhs = struct if Z.equal c Z.one then "" else if Z.equal c Z.minus_one then "-" else (Z.to_string c) ^"·" - let show_rhs_formatted formatter = let ztostring n = if Z.(geq n zero) then "+" else "" ^ Z.to_string n in + let show_rhs_formatted formatter = let ztostring n = (if Z.(geq n zero) then "+" else "") ^ Z.to_string n in function | (Some (coeff,v), o,_) when Z.equal o Z.zero -> Printf.sprintf "%s%s" (show_coeff coeff) (formatter v) | (Some (coeff,v), o,_) -> Printf.sprintf "%s%s %s" (show_coeff coeff) (formatter v) (ztostring o) From 075f2e858293e899f6f27f066629d27a2f62b306 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Tue, 28 May 2024 15:57:04 +0200 Subject: [PATCH 046/107] fix unmatched monom in forget_variable --- .../apron/linearTwoVarEqualityDomain.apron.ml | 6 ++++-- .../regression/77-lin2vareq/34-coefficient-features.c | 11 ----------- 2 files changed, 4 insertions(+), 13 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 0a110a5999..2da7deb5cc 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -104,7 +104,7 @@ module EqualitiesConjunction = struct let offsetlist = Array.to_list indexes in let rec bumpvar delta i = function (* bump the variable i by delta; find delta by counting indices in offsetlist until we reach a larger index then our current parameter *) | head::rest when i>=head -> bumpvar (delta+1) i rest (* rec call even when =, in order to correctly interpret double bumps *) - | _ (* i op i delta + | _ (* i let res = op i delta in res in let memobumpvar = (* Memoized version of bumpvar *) let module IntHash = struct type t = int [@@deriving eq,hash] end in @@ -145,9 +145,11 @@ module EqualitiesConjunction = struct (let ref_var_opt = Tuple3.first (get_rhs d var) in match ref_var_opt with | Some (_,ref_var) when ref_var = var -> + if M.tracing then M.trace "forget" "headvar var_%d" var; (* var is the reference variable of its connected component *) (let cluster = IntMap.fold - (fun i (ref,_,_) l -> if ref = ref_var_opt then i::l else l) (snd d) [] in + (fun i (ref,_,_) l -> BatOption.map_default (fun (coeff,ref) -> if (ref=ref_var) then i::l else l) l ref) (snd d) [] in + if M.tracing then M.trace "forget" "cluster varindices: [%s]" (String.concat ", " (List.map (string_of_int) cluster)); (* obtain cluster with common reference variable ref_var*) match cluster with (* new ref_var is taken from head of the cluster *) | head :: _ -> diff --git a/tests/regression/77-lin2vareq/34-coefficient-features.c b/tests/regression/77-lin2vareq/34-coefficient-features.c index b415f4398a..561eccf0af 100644 --- a/tests/regression/77-lin2vareq/34-coefficient-features.c +++ b/tests/regression/77-lin2vareq/34-coefficient-features.c @@ -21,17 +21,6 @@ void loop() { __goblint_check(x == 4*i); //SUCCESS - for(i = 1; i < 100; i++) { - x=x+4; - y=y+8; - - __goblint_check(y == 2*x); //SUCCESS - - int res = (y==2*x )+ 1; - - __goblint_check(res); //SUCCESS - } - x=0; y=0; From 94ebf865fc261825d3d137f4d8203a5da8be1ba3 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 29 May 2024 10:57:03 +0200 Subject: [PATCH 047/107] fixed broken is_top --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 2da7deb5cc..f6ae9b2c51 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -400,7 +400,7 @@ struct let top () = {d = Some (EConj.empty()); env = empty_env} (** is_top returns true for top_of array and empty array; precondition: t.env and t.d are of same size *) - let is_top t = Environment.equal empty_env t.env && GobOption.exists EConj.is_top_con t.d + let is_top t = GobOption.exists EConj.is_top_con t.d let to_subscript i = let transl = [|"₀";"₁";"₂";"₃";"₄";"₅";"₆";"₇";"₈";"₉"|] in @@ -472,8 +472,8 @@ struct | Some (coeffj,j) -> tuple_cmp (EConj.get_rhs ts i) @@ Rhs.subst (EConj.get_rhs ts j) j (var, offs, divi) in if env_comp = -2 || env_comp > 0 then false else - if is_bot_env t1 || is_top t2 then true else - if is_bot_env t2 || is_top t1 then false else + if is_bot_env t1 || is_top t2 then true + else if is_bot_env t2 || is_top t1 then false else let m1, m2 = Option.get t1.d, Option.get t2.d in let m1' = if env_comp = 0 then m1 else VarManagement.dim_add (Environment.dimchange t1.env t2.env) m1 in EConj.IntMap.for_all (implies m1') (snd m2) (* even on sparse m2, it suffices to check the non-trivial equalities, still present in sparse m2 *) From 9663b1c772277fc3eb80b1a0ce4e3b7fd19bf46d Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 29 May 2024 13:17:04 +0200 Subject: [PATCH 048/107] make combine tracing in relational analysis more specific --- src/analyses/apron/relationAnalysis.apron.ml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 6c118dac7a..97fd66d676 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -388,11 +388,11 @@ struct let st = ctx.local in let reachable_from_args = reachable_from_args ctx args in let fundec = Node.find_fundec ctx.node in - if M.tracing then M.tracel "combine" "relation f: %a" CilType.Varinfo.pretty f.svar; - if M.tracing then M.tracel "combine" "relation formals: %a" (d_list "," CilType.Varinfo.pretty) f.sformals; - if M.tracing then M.tracel "combine" "relation args: %a" (d_list "," d_exp) args; - if M.tracing then M.tracel "combine" "relation st: %a" D.pretty st; - if M.tracing then M.tracel "combine" "relation fun_st: %a" D.pretty fun_st; + if M.tracing then M.tracel "combine-rel" "relation f: %a" CilType.Varinfo.pretty f.svar; + if M.tracing then M.tracel "combine-rel" "relation formals: %a" (d_list "," CilType.Varinfo.pretty) f.sformals; + if M.tracing then M.tracel "combine-rel" "relation args: %a" (d_list "," d_exp) args; + if M.tracing then M.tracel "combine-rel" "relation st: %a" D.pretty st; + if M.tracing then M.tracel "combine-rel" "relation fun_st: %a" D.pretty fun_st; let new_fun_rel = RD.add_vars fun_st.rel (RD.vars st.rel) in let arg_substitutes = let filter_actuals (x,e) = @@ -418,7 +418,7 @@ struct in let any_local_reachable = any_local_reachable fundec reachable_from_args in let arg_vars = f.sformals |> List.filter (RD.Tracked.varinfo_tracked) |> List.map RV.arg in - if M.tracing then M.tracel "combine" "relation remove vars: %a" (docList (fun v -> Pretty.text (Apron.Var.to_string v))) arg_vars; + if M.tracing then M.tracel "combine-rel" "relation remove vars: %a" (docList (fun v -> Pretty.text (Apron.Var.to_string v))) arg_vars; RD.remove_vars_with new_fun_rel arg_vars; (* fine to remove arg vars that also exist in caller because unify from new_rel adds them back with proper constraints *) let tainted = f_ask.f Queries.MayBeTainted in let tainted_vars = TaintPartialContexts.conv_varset tainted in @@ -432,7 +432,7 @@ struct ) in let unify_rel = RD.unify new_rel new_fun_rel in (* TODO: unify_with *) - if M.tracing then M.tracel "combine" "relation unifying %a %a = %a" RD.pretty new_rel RD.pretty new_fun_rel RD.pretty unify_rel; + if M.tracing then M.tracel "combine-rel" "relation unifying %a %a = %a" RD.pretty new_rel RD.pretty new_fun_rel RD.pretty unify_rel; {fun_st with rel = unify_rel} let combine_assign ctx r fe f args fc fun_st (f_ask : Queries.ask) = From caa8437fcbdbd2182c2f8a6aa50ea33a72ad58cb Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 29 May 2024 13:18:04 +0200 Subject: [PATCH 049/107] forget did not forget about the actual head-variable of the new cluster --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index f6ae9b2c51..d2489689e1 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -152,17 +152,18 @@ module EqualitiesConjunction = struct if M.tracing then M.trace "forget" "cluster varindices: [%s]" (String.concat ", " (List.map (string_of_int) cluster)); (* obtain cluster with common reference variable ref_var*) match cluster with (* new ref_var is taken from head of the cluster *) - | head :: _ -> + | head :: clusterrest -> (* ax = by + c /\ a'z = b'y + c' *) (* ==[[ y:=? ]]==> (a'b)z = (b'a)x + c' -(b'c) *) let (newref,c,a) = (get_rhs d head) in (* take offset between old and new reference variable *) let (b,_) = BatOption.get newref in - List.fold (fun map i -> + let shifted_cluster = (List.fold (fun map i -> (* shift offset to match new reference variable *) let (oldref,c',a') = (get_rhs d i) in let (b',_) = BatOption.get oldref in (Some (Z.(b'*a),head), Z.(c' - (b' * c)), Z.(a'*b)) |> canonicalize_and_set map i - ) d cluster (* shift offset to match new reference variable *) + ) d clusterrest) in + set_rhs shifted_cluster head (Rhs.var_zero head) (* finally make sure that head is now trivial *) | [] -> d) (* empty cluster means no work for us *) | _ -> d) (* variable is either a constant or expressed by another refvar *) in let res = (fst res, IntMap.remove var (snd res)) in (* set d(var) to unknown, finally *) From e1462b308d7695b37ac9041b1a465c70bdc15657 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Wed, 29 May 2024 14:58:40 +0200 Subject: [PATCH 050/107] fixed forget_variable by a) sorting vars in cluster and b) rehauling cluster transformation with subst/inverse convenience functions --- .../apron/linearTwoVarEqualityDomain.apron.ml | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index d2489689e1..923229ca96 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -147,21 +147,21 @@ module EqualitiesConjunction = struct | Some (_,ref_var) when ref_var = var -> if M.tracing then M.trace "forget" "headvar var_%d" var; (* var is the reference variable of its connected component *) - (let cluster = IntMap.fold + (let cluster = List.sort (Int.compare) @@ IntMap.fold (fun i (ref,_,_) l -> BatOption.map_default (fun (coeff,ref) -> if (ref=ref_var) then i::l else l) l ref) (snd d) [] in if M.tracing then M.trace "forget" "cluster varindices: [%s]" (String.concat ", " (List.map (string_of_int) cluster)); (* obtain cluster with common reference variable ref_var*) match cluster with (* new ref_var is taken from head of the cluster *) | head :: clusterrest -> - (* ax = by + c /\ a'z = b'y + c' *) - (* ==[[ y:=? ]]==> (a'b)z = (b'a)x + c' -(b'c) *) - let (newref,c,a) = (get_rhs d head) in (* take offset between old and new reference variable *) - let (b,_) = BatOption.get newref in - let shifted_cluster = (List.fold (fun map i -> (* shift offset to match new reference variable *) - let (oldref,c',a') = (get_rhs d i) in - let (b',_) = BatOption.get oldref in - (Some (Z.(b'*a),head), Z.(c' - (b' * c)), Z.(a'*b)) |> - canonicalize_and_set map i + (* head: divi*x = coeff*y + offs *) + (* divi*x = coeff*y + offs =inverse=> y =( divi*x - offs)/coeff *) + let (newref,offs,divi) = (get_rhs d head) in + let (coeff,y) = BatOption.get newref in + let (y,yrhs)= inverse head (coeff,y,offs,divi) in (* reassemble yrhs out of components *) + let shifted_cluster = (List.fold (fun map i -> + let irhs = (get_rhs d i) in (* old entry is i = irhs *) + Rhs.subst yrhs y irhs |> (* new entry for i is irhs [yrhs/y] *) + set_rhs map i ) d clusterrest) in set_rhs shifted_cluster head (Rhs.var_zero head) (* finally make sure that head is now trivial *) | [] -> d) (* empty cluster means no work for us *) @@ -240,7 +240,7 @@ module EqualitiesConjunction = struct let (_,newh1)= inverse i (coeff1,h1,o1,divi1) in let newh1 = Rhs.subst normalizedj j (Rhs.subst (Some(coeff,j),offs,divi) i newh1) in subst_var ts h1 newh1)) in - if M.tracing then M.trace "meet_with_one_conj" "meet_with_one_conj conj: %s eq: var_%d=%s -> %s " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd res)) + if M.tracing then M.tracel "meet_with_one_conj" "meet_with_one_conj conj: %s eq: var_%d=%s -> %s " (show (snd ts)) i (Rhs.show (var,offs,divi)) (show (snd res)) ; res (** affine transform variable i allover conj with transformer (Some (coeff,i)+offs)/divi *) From 35a4382efc2509e46a64edc7dc2effa8fc10060f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 31 May 2024 14:31:54 +0300 Subject: [PATCH 051/107] Simplify SetDomain.FiniteSet arguments --- src/domain/setDomain.ml | 12 ++++++------ tests/unit/maindomaintest.ml | 9 +++------ 2 files changed, 9 insertions(+), 12 deletions(-) diff --git a/src/domain/setDomain.ml b/src/domain/setDomain.ml index 1b5239de80..9b545a78ee 100644 --- a/src/domain/setDomain.ml +++ b/src/domain/setDomain.ml @@ -436,23 +436,23 @@ struct include Lattice.Reverse (Base) end -module type FiniteSetElems = +module type FiniteSetElem = sig - type t + include Printable.S val elems: t list + (** List of all possible elements. *) end -(* TODO: put elems into E *) -module FiniteSet (E:Printable.S) (Elems:FiniteSetElems with type t = E.t) = +module FiniteSet (E: FiniteSetElem) = struct module E = struct include E - let arbitrary () = QCheck.oneofl Elems.elems + let arbitrary () = QCheck.oneofl E.elems end include Make (E) - let top () = of_list Elems.elems + let top () = of_list E.elems let is_top x = equal x (top ()) end diff --git a/tests/unit/maindomaintest.ml b/tests/unit/maindomaintest.ml index 8e6a7f5a3a..8e1db76b83 100644 --- a/tests/unit/maindomaintest.ml +++ b/tests/unit/maindomaintest.ml @@ -15,14 +15,11 @@ struct let show = show end include Printable.SimpleShow (P) + + let elems = ['a'; 'b'; 'c'; 'd'] end -module ArbitraryLattice = SetDomain.FiniteSet (PrintableChar) ( - struct - type t = char - let elems = ['a'; 'b'; 'c'; 'd'] - end - ) +module ArbitraryLattice = SetDomain.FiniteSet (PrintableChar) module HoareArbitrary = HoareDomain.Set_LiftTop (ArbitraryLattice) (struct let topname = "Top" end) module HoareArbitrary_NoTop = HoareDomain.Set (ArbitraryLattice) From 07f539ffd4433913c087fb5d99f9bb5e5db3bc3f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 31 May 2024 14:33:39 +0300 Subject: [PATCH 052/107] Update first analysis tutorial regarding SetDomain.FiniteSet --- docs/developer-guide/firstanalysis.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/developer-guide/firstanalysis.md b/docs/developer-guide/firstanalysis.md index 4eb35e7f5d..b32538134b 100644 --- a/docs/developer-guide/firstanalysis.md +++ b/docs/developer-guide/firstanalysis.md @@ -80,4 +80,4 @@ For example, have a look at the following program: `tests/regression/99-tutorial _Hint:_ The easiest way to do this is to use the powerset lattice of `{-, 0, +}`. For example, "non-negative" is represented by `{0, +}`, while negative is represented by `{-}`. -To do this, modify `SL` by using `SetDomain.FiniteSet` (takes a `struct` with a list of finite elements as second parameter) instead of `Lattice.Flat` and reimplementing the two functions using `singleton` and `for_all`. +To do this, modify `SL` by using `SetDomain.FiniteSet` (which needs a finite list of elements to be added to `Signs`) instead of `Lattice.Flat` and reimplementing the two functions using `singleton` and `for_all`. From 325dd23a98666c21bf619fe9b08ca1f610a8ded0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 31 May 2024 14:47:29 +0300 Subject: [PATCH 053/107] Fix typo in first analysis tutorial --- docs/developer-guide/firstanalysis.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/developer-guide/firstanalysis.md b/docs/developer-guide/firstanalysis.md index b32538134b..c9e3c58720 100644 --- a/docs/developer-guide/firstanalysis.md +++ b/docs/developer-guide/firstanalysis.md @@ -74,7 +74,7 @@ For more information on the signature of the individual transfer functions, plea ## Extending the domain You could now enrich the lattice to also have a representation for non-negative (i.e., zero or positive) values. -Then the join of `Zero` and `Pos` would be "non-negative" instead of `Top`, allowing you to prove that such join is greated than `Neg`. +Then the join of `Zero` and `Pos` would be "non-negative" instead of `Top`, allowing you to prove that such join is greater than `Neg`. For example, have a look at the following program: `tests/regression/99-tutorials/02-first-extend.c`. _Hint:_ From 24d273bd0b44e98f523d6fea680ec5afb77768de Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 31 May 2024 14:47:53 +0300 Subject: [PATCH 054/107] Remove unnecessary warn.debug from first analysis tutorial --- docs/developer-guide/firstanalysis.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/developer-guide/firstanalysis.md b/docs/developer-guide/firstanalysis.md index c9e3c58720..bd4dfb3c11 100644 --- a/docs/developer-guide/firstanalysis.md +++ b/docs/developer-guide/firstanalysis.md @@ -35,7 +35,7 @@ This program is in the Goblint repository: `tests/regression/99-tutorials/01-fir But if you run Goblint out of the box on this example, it will not work: ```console -./goblint --enable warn.debug tests/regression/99-tutorials/01-first.c +./goblint tests/regression/99-tutorials/01-first.c ``` This will claim that the assertion in unknown. From 83d771b63a6c38edc5e344b078f59d989c81786f Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Mon, 3 Jun 2024 14:52:57 +0300 Subject: [PATCH 055/107] Improve zeroinit output by removing negation --- src/analyses/base.ml | 11 ++++++----- src/cdomain/value/cdomains/valueDomain.ml | 23 ++++++++++++++++++----- 2 files changed, 24 insertions(+), 10 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 67e6276239..c33aaa4abb 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -17,6 +17,7 @@ module IdxDom = ValueDomain.IndexDomain module AD = ValueDomain.AD module Addr = ValueDomain.Addr module Offs = ValueDomain.Offs +module ZeroInit = ValueDomain.ZeroInit module LF = LibraryFunctions module CArrays = ValueDomain.CArrays module PU = PrecisionUtil @@ -2652,7 +2653,7 @@ struct | Some lv -> let heap_var = AD.of_var (heap_var true ctx) in (* ignore @@ printf "alloca will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) - set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, true)); + set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] | _ -> st end @@ -2665,7 +2666,7 @@ struct else AD.of_var (heap_var false ctx) in (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) - set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, true)); + set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] | _ -> st end @@ -2682,7 +2683,7 @@ struct let countval = eval_int ~ctx st n in if ID.to_int countval = Some Z.one then ( set_many ~ctx st [ - (add_null (AD.of_var heap_var), TVoid [], Blob (VD.bot (), sizeval, false)); + (add_null (AD.of_var heap_var), TVoid [], Blob (VD.bot (), sizeval, ZeroInit.calloc)); (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_var heap_var))) ] ) @@ -2690,7 +2691,7 @@ struct let blobsize = ID.mul (ID.cast_to ik @@ sizeval) (ID.cast_to ik @@ countval) in (* the memory that was allocated by calloc is set to bottom, but we keep track that it originated from calloc, so when bottom is read from memory allocated by calloc it is turned to zero *) set_many ~ctx st [ - (add_null (AD.of_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.one) (Blob (VD.bot (), blobsize, false)))); + (add_null (AD.of_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.one) (Blob (VD.bot (), blobsize, ZeroInit.calloc)))); (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_mval (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.zero, `NoOffset))))) ] ) @@ -2713,7 +2714,7 @@ struct let p_addr' = AD.remove NullPtr p_addr in (* realloc with NULL is same as malloc, remove to avoid unknown value from NullPtr access *) let p_addr_get = get ~ctx st p_addr' None in (* implicitly includes join of malloc value (VD.bot) *) let size_int = eval_int ~ctx st size in - let heap_val:value = Blob (p_addr_get, size_int, true) in (* copy old contents with new size *) + let heap_val:value = Blob (p_addr_get, size_int, ZeroInit.malloc) in (* copy old contents with new size *) let heap_addr = AD.of_var (heap_var false ctx) in let heap_addr' = if get_bool "sem.malloc.fail" then diff --git a/src/cdomain/value/cdomains/valueDomain.ml b/src/cdomain/value/cdomains/valueDomain.ml index de64fde807..12c86abf60 100644 --- a/src/cdomain/value/cdomains/valueDomain.ml +++ b/src/cdomain/value/cdomains/valueDomain.ml @@ -57,11 +57,24 @@ sig val invalidate_value: VDQ.t -> typ -> t -> t end -(* ZeroInit is true if malloc was used to allocate memory and it's false if calloc was used *) -module ZeroInit = +module type ZeroInit = +sig + include Lattice.S + + val is_malloc : t -> bool + val malloc : t + val calloc : t +end + +(* ZeroInit is false if malloc was used to allocate memory and true if calloc was used *) +module ZeroInit : ZeroInit = struct include Lattice.Fake(Basetype.RawBools) - let name () = "no zeroinit" + let name () = "zeroinit" + + let is_malloc x = not x + let malloc = false + let calloc = true end module Blob (Value: S) (Size: IntDomain.Z)= @@ -862,8 +875,8 @@ struct end | _, _ -> None - let zero_init_calloced_memory orig x t = - if orig then + let zero_init_calloced_memory zeroinit x t = + if ZeroInit.is_malloc zeroinit then (* This Blob came from malloc *) x else if x = Bot then From d19f9c9c8bab362a43a0b6cd1d819540d475bc07 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Mon, 3 Jun 2024 15:10:49 +0300 Subject: [PATCH 056/107] Rename origin -> zeroinit --- src/cdomain/value/cdomains/valueDomain.ml | 46 +++++++++++------------ 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/src/cdomain/value/cdomains/valueDomain.ml b/src/cdomain/value/cdomains/valueDomain.ml index 12c86abf60..dd8ac844e3 100644 --- a/src/cdomain/value/cdomains/valueDomain.ml +++ b/src/cdomain/value/cdomains/valueDomain.ml @@ -49,8 +49,8 @@ module type Blob = sig type value type size - type origin - include Lattice.S with type t = value * size * origin + type zeroinit + include Lattice.S with type t = value * size * zeroinit val map: (value -> value) -> t -> t val value: t -> value @@ -83,7 +83,7 @@ struct let name () = "blob" type value = Value.t type size = Size.t - type origin = ZeroInit.t + type zeroinit = ZeroInit.t let map f (v, s, o) = f v, s, o let value (a, b, c) = a @@ -891,23 +891,23 @@ struct if M.tracing then M.traceli "eval_offset" "do_eval_offset %a %a (%a)" pretty x Offs.pretty offs (Pretty.docOpt (CilType.Exp.pretty ())) exp; let r = match x, offs with - | Blob((va, _, orig) as c), `Index (_, ox) -> + | Blob((va, _, zeroinit) as c), `Index (_, ox) -> begin let l', o' = shift_one_over l o in let ev = do_eval_offset ask f (Blobs.value c) ox exp l' o' v t in - zero_init_calloced_memory orig ev t + zero_init_calloced_memory zeroinit ev t end - | Blob((va, _, orig) as c), `Field _ -> + | Blob((va, _, zeroinit) as c), `Field _ -> begin let l', o' = shift_one_over l o in let ev = do_eval_offset ask f (Blobs.value c) offs exp l' o' v t in - zero_init_calloced_memory orig ev t + zero_init_calloced_memory zeroinit ev t end - | Blob((va, _, orig) as c), `NoOffset -> + | Blob((va, _, zeroinit) as c), `NoOffset -> begin let l', o' = shift_one_over l o in let ev = do_eval_offset ask f (Blobs.value c) offs exp l' o' v t in - zero_init_calloced_memory orig ev t + zero_init_calloced_memory zeroinit ev t end | Bot, _ -> Bot | _ -> @@ -965,24 +965,24 @@ struct let update_offset ?(blob_destructive=false) (ask: VDQ.t) (x:t) (offs:offs) (value:t) (exp:exp option) (v:lval) (t:typ): t = let rec do_update_offset (ask:VDQ.t) (x:t) (offs:offs) (value:t) (exp:exp option) (l:lval option) (o:offset option) (v:lval) (t:typ):t = if M.tracing then M.traceli "update_offset" "do_update_offset %a %a (%a) %a" pretty x Offs.pretty offs (Pretty.docOpt (CilType.Exp.pretty ())) exp pretty value; - let mu = function Blob (Blob (y, s', orig), s, orig2) -> Blob (y, ID.join s s',orig) | x -> x in + let mu = function Blob (Blob (y, s', zeroinit), s, _) -> Blob (y, ID.join s s', zeroinit) | x -> x in let r = match x, offs with | Mutex, _ -> (* hide mutex structure contents, not updated anyway *) Mutex - | Blob (x,s,orig), `Index (_,ofs) -> + | Blob (x,s,zeroinit), `Index (_,ofs) -> begin let l', o' = shift_one_over l o in - let x = zero_init_calloced_memory orig x t in - mu (Blob (join x (do_update_offset ask x ofs value exp l' o' v t), s, orig)) + let x = zero_init_calloced_memory zeroinit x t in + mu (Blob (join x (do_update_offset ask x ofs value exp l' o' v t), s, zeroinit)) end - | Blob (x,s,orig), `Field(f, _) -> + | Blob (x,s,zeroinit), `Field(f, _) -> begin (* We only have Blob for dynamically allocated memory. In these cases t is the type of the lval used to access it, i.e. for a struct s {int x; int y;} a; accessed via a->x *) (* will be int. Here, we need a zero_init of the entire contents of the blob though, which we get by taking the associated f.fcomp. Putting [] for attributes is ok, as we don't *) (* consider them in VD *) let l', o' = shift_one_over l o in - let x = zero_init_calloced_memory orig x (TComp (f.fcomp, [])) in + let x = zero_init_calloced_memory zeroinit x (TComp (f.fcomp, [])) in (* Strong update of scalar variable is possible if the variable is unique and size of written value matches size of blob being written to. *) let do_strong_update = match v with @@ -996,14 +996,14 @@ struct | _ -> false in if do_strong_update then - Blob ((do_update_offset ask x offs value exp l' o' v t), s, orig) + Blob ((do_update_offset ask x offs value exp l' o' v t), s, zeroinit) else - mu (Blob (join x (do_update_offset ask x offs value exp l' o' v t), s, orig)) + mu (Blob (join x (do_update_offset ask x offs value exp l' o' v t), s, zeroinit)) end - | Blob (x,s,orig), _ -> + | Blob (x,s,zeroinit), _ -> begin let l', o' = shift_one_over l o in - let x = zero_init_calloced_memory orig x t in + let x = zero_init_calloced_memory zeroinit x t in (* Strong update of scalar variable is possible if the variable is unique and size of written value matches size of blob being written to. *) let do_strong_update = begin match v with @@ -1019,9 +1019,9 @@ struct end in if do_strong_update then - Blob ((do_update_offset ask x offs value exp l' o' v t), s, orig) + Blob ((do_update_offset ask x offs value exp l' o' v t), s, zeroinit) else - mu (Blob (join x (do_update_offset ask x offs value exp l' o' v t), s, orig)) + mu (Blob (join x (do_update_offset ask x offs value exp l' o' v t), s, zeroinit)) end | Thread _, _ -> (* hack for pthread_t variables *) @@ -1049,7 +1049,7 @@ struct match offs with | `NoOffset -> begin match value with - | Blob (y, s, orig) -> mu (Blob (join x y, s, orig)) + | Blob (y, s, zeroinit) -> mu (Blob (join x y, s, zeroinit)) | Int _ -> cast t value | _ -> value end @@ -1302,7 +1302,7 @@ and Unions: UnionDomain.S with type t = UnionDomain.Field.t * Compound.t and typ and CArrays: ArrayDomain.StrWithDomain with type value = Compound.t and type idx = ArrIdxDomain.t = ArrayDomain.AttributeConfiguredAndNullByteArrayDomain(Compound)(ArrIdxDomain) -and Blobs: Blob with type size = ID.t and type value = Compound.t and type origin = ZeroInit.t = Blob (Compound) (ID) +and Blobs: Blob with type size = ID.t and type value = Compound.t and type zeroinit = ZeroInit.t = Blob (Compound) (ID) module type InvariantArg = From 86be1d04d4db322cc8bf4504a778f18e910586ac Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 11:35:58 +0300 Subject: [PATCH 057/107] Add unsound test for unlocking non-definite mutex in privatizations --- .../13-privatized/93-unlock-idx-ambiguous.c | 27 +++++++ .../13-privatized/93-unlock-idx-ambiguous.t | 75 +++++++++++++++++++ tests/regression/13-privatized/dune | 2 + 3 files changed, 104 insertions(+) create mode 100644 tests/regression/13-privatized/93-unlock-idx-ambiguous.c create mode 100644 tests/regression/13-privatized/93-unlock-idx-ambiguous.t create mode 100644 tests/regression/13-privatized/dune diff --git a/tests/regression/13-privatized/93-unlock-idx-ambiguous.c b/tests/regression/13-privatized/93-unlock-idx-ambiguous.c new file mode 100644 index 0000000000..081302514b --- /dev/null +++ b/tests/regression/13-privatized/93-unlock-idx-ambiguous.c @@ -0,0 +1,27 @@ +// PARAM: --set ana.base.privatization protection --enable ana.sv-comp.functions +#include +#include +extern _Bool __VERIFIER_nondet_bool(); + +int g; +pthread_mutex_t m[2] = {PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER}; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m[0]); + pthread_mutex_lock(&m[1]); // so we're unlocking a mutex we definitely hold + g++; + int r = __VERIFIER_nondet_bool(); + pthread_mutex_unlock(&m[r]); // TODO NOWARN (definitely held either way) + // could have unlocked m[0], so should have published g there + return NULL; +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + pthread_mutex_lock(&m[0]); + __goblint_check(g == 0); // UNKNOWN! + pthread_mutex_unlock(&m[0]); + return 0; +} diff --git a/tests/regression/13-privatized/93-unlock-idx-ambiguous.t b/tests/regression/13-privatized/93-unlock-idx-ambiguous.t new file mode 100644 index 0000000000..f954ac1d4c --- /dev/null +++ b/tests/regression/13-privatized/93-unlock-idx-ambiguous.t @@ -0,0 +1,75 @@ +TODO: should not succeed + + $ goblint --set ana.base.privatization protection --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) + [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + +TODO: should not succeed + + $ goblint --set ana.base.privatization mutex-meet --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) + [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + +TODO: should not succeed + + $ goblint --set ana.base.privatization lock --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) + [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + +TODO: should not succeed + + $ goblint --set ana.base.privatization write --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) + [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + +TODO: should not succeed + + $ goblint --set ana.base.privatization mine-nothread --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) + [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + diff --git a/tests/regression/13-privatized/dune b/tests/regression/13-privatized/dune new file mode 100644 index 0000000000..23c0dd3290 --- /dev/null +++ b/tests/regression/13-privatized/dune @@ -0,0 +1,2 @@ +(cram + (deps (glob_files *.c))) From e6429f02214a42d1f50bc1c1ab0d304018f516df Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 14:32:41 +0300 Subject: [PATCH 058/107] Fix base privatization unsoundness with non-definite mutex unlock --- src/analyses/base.ml | 34 +++++++++++++++---- .../13-privatized/93-unlock-idx-ambiguous.t | 20 +++-------- 2 files changed, 33 insertions(+), 21 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 67e6276239..13cf9f20da 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -3062,13 +3062,35 @@ struct match e with | Events.Lock (addr, _) when ThreadFlag.has_ever_been_multi ask -> (* TODO: is this condition sound? *) if M.tracing then M.tracel "priv" "LOCK EVENT %a" LockDomain.Addr.pretty addr; - Priv.lock ask (priv_getg ctx.global) st addr + begin match addr with + | UnknownPtr -> ctx.local + | Addr (v, _) when ctx.ask (IsMultiple v) -> ctx.local + | Addr (v, o) when Addr.Mval.is_definite (v, o) -> + Priv.lock ask (priv_getg ctx.global) st addr + | _ -> ctx.local + end | Events.Unlock addr when ThreadFlag.has_ever_been_multi ask -> (* TODO: is this condition sound? *) - if addr = UnknownPtr then - M.info ~category:Unsound "Unknown mutex unlocked, base privatization unsound"; (* TODO: something more sound *) - WideningTokens.with_local_side_tokens (fun () -> - Priv.unlock ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st addr - ) + begin match addr with + | UnknownPtr -> + M.info ~category:Unsound "Unknown mutex unlocked, base privatization unsound"; (* TODO: something more sound *) + ctx.local (* TODO: remove all! *) + | Addr (v, o) when Addr.Mval.is_definite (v, o) -> + WideningTokens.with_local_side_tokens (fun () -> + Priv.unlock ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st addr + ) + | Addr (v, o) -> + WideningTokens.with_local_side_tokens (fun () -> + let s = ctx.ask MustLockset in + LockDomain.MustLockset.fold (fun ml st -> + if LockDomain.MustLock.semantic_equal_mval ml (v, o) = Some false then + st + else + let addr = Addr.Addr (LockDomain.MustLock.to_mval ml) in + Priv.unlock ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st addr + ) s st + ) + | _ -> ctx.local + end | Events.Escape escaped -> Priv.escape ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st escaped | Events.EnterMultiThreaded -> diff --git a/tests/regression/13-privatized/93-unlock-idx-ambiguous.t b/tests/regression/13-privatized/93-unlock-idx-ambiguous.t index f954ac1d4c..8f24d728bf 100644 --- a/tests/regression/13-privatized/93-unlock-idx-ambiguous.t +++ b/tests/regression/13-privatized/93-unlock-idx-ambiguous.t @@ -1,8 +1,6 @@ -TODO: should not succeed - $ goblint --set ana.base.privatization protection --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) - [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Warning][Assert] Assertion "g == 0" is unknown. (93-unlock-idx-ambiguous.c:24:3-24:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 @@ -13,11 +11,9 @@ TODO: should not succeed unsafe: 0 total memory locations: 1 -TODO: should not succeed - $ goblint --set ana.base.privatization mutex-meet --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) - [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Warning][Assert] Assertion "g == 0" is unknown. (93-unlock-idx-ambiguous.c:24:3-24:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 @@ -28,11 +24,9 @@ TODO: should not succeed unsafe: 0 total memory locations: 1 -TODO: should not succeed - $ goblint --set ana.base.privatization lock --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) - [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Warning][Assert] Assertion "g == 0" is unknown. (93-unlock-idx-ambiguous.c:24:3-24:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 @@ -43,11 +37,9 @@ TODO: should not succeed unsafe: 0 total memory locations: 1 -TODO: should not succeed - $ goblint --set ana.base.privatization write --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) - [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Warning][Assert] Assertion "g == 0" is unknown. (93-unlock-idx-ambiguous.c:24:3-24:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 @@ -58,11 +50,9 @@ TODO: should not succeed unsafe: 0 total memory locations: 1 -TODO: should not succeed - $ goblint --set ana.base.privatization mine-nothread --enable ana.sv-comp.functions 93-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (93-unlock-idx-ambiguous.c:14:3-14:30) - [Success][Assert] Assertion "g == 0" will succeed (93-unlock-idx-ambiguous.c:24:3-24:26) + [Warning][Assert] Assertion "g == 0" is unknown. (93-unlock-idx-ambiguous.c:24:3-24:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 From b5bdf56373ac0ffd02728e1e55d7a512241c9562 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Sun, 2 Jun 2024 18:26:57 +0200 Subject: [PATCH 059/107] int intervals: allow narrowing from widening thresholds --- src/cdomain/value/cdomains/intDomain.ml | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 3bf81b1ba1..f482842ca8 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -572,6 +572,16 @@ module IntervalArith (Ints_t : IntOps.IntOps) = struct let min_ik' = Ints_t.to_bigint min_ik in let t = List.find_opt (fun x -> Z.compare l x >= 0 && Z.compare x min_ik' >= 0) ts in BatOption.map_default Ints_t.of_bigint min_ik t + let is_upper_threshold u = + let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in + let u = Ints_t.to_bigint u in + let t = List.find_opt (fun x -> Z.compare u x = 0) ts in + Option.is_some t + let is_lower_threshold l = + let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in + let l = Ints_t.to_bigint l in + let t = List.find_opt (fun x -> Z.compare l x = 0) ts in + Option.is_some t end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = @@ -702,9 +712,10 @@ struct match x, y with | _,None | None, _ -> None | Some (x1,x2), Some (y1,y2) -> + let threshold = get_interval_threshold_widening () in let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 then y2 else x2 in + let lr = if Ints_t.compare min_ik x1 = 0 || threshold && IArith.is_lower_threshold x1 then y1 else x1 in + let ur = if Ints_t.compare max_ik x2 = 0 || threshold && IArith.is_upper_threshold x2 then y2 else x2 in norm ik @@ Some (lr,ur) |> fst From 87d9a3b5c2b9848105805e08a2e30bb566c40595 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Tue, 4 Jun 2024 13:03:59 +0200 Subject: [PATCH 060/107] add test for narrowing from thresholds --- tests/regression/03-practical/33-threshold-narrowing.c | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 tests/regression/03-practical/33-threshold-narrowing.c diff --git a/tests/regression/03-practical/33-threshold-narrowing.c b/tests/regression/03-practical/33-threshold-narrowing.c new file mode 100644 index 0000000000..0c713fa273 --- /dev/null +++ b/tests/regression/03-practical/33-threshold-narrowing.c @@ -0,0 +1,8 @@ +// PARAM: --enable ana.int.interval --enable ana.int.interval_threshold_widening --set ana.int.interval_threshold_widening_constants comparisons +#include + +int main() { + int i; + for(i = 0; i < 10 && i < 20; i += 3); + __goblint_check(i <= 12); +} From ee6a4fb363337cfeb3da593f9c1e0f3e1bc552bd Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 15:10:30 +0300 Subject: [PATCH 061/107] Add unsound test for unlocking non-definite mutex in relational privatizations --- .../46-apron2/87-unlock-idx-ambiguous.c | 28 +++++++++++++ .../46-apron2/87-unlock-idx-ambiguous.t | 39 +++++++++++++++++++ tests/regression/46-apron2/dune | 3 ++ 3 files changed, 70 insertions(+) create mode 100644 tests/regression/46-apron2/87-unlock-idx-ambiguous.c create mode 100644 tests/regression/46-apron2/87-unlock-idx-ambiguous.t diff --git a/tests/regression/46-apron2/87-unlock-idx-ambiguous.c b/tests/regression/46-apron2/87-unlock-idx-ambiguous.c new file mode 100644 index 0000000000..97cada5369 --- /dev/null +++ b/tests/regression/46-apron2/87-unlock-idx-ambiguous.c @@ -0,0 +1,28 @@ +// PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag +// TODO: why nonterm without threadflag path-sens? +#include +#include +extern _Bool __VERIFIER_nondet_bool(); + +int g; +pthread_mutex_t m[2] = {PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER}; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m[0]); + pthread_mutex_lock(&m[1]); // so we're unlocking a mutex we definitely hold + g++; + int r = __VERIFIER_nondet_bool(); + pthread_mutex_unlock(&m[r]); // TODO NOWARN (definitely held either way) + // could have unlocked m[0], so should have published g there + return NULL; +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + pthread_mutex_lock(&m[0]); + __goblint_check(g == 0); // UNKNOWN! + pthread_mutex_unlock(&m[0]); + return 0; +} diff --git a/tests/regression/46-apron2/87-unlock-idx-ambiguous.t b/tests/regression/46-apron2/87-unlock-idx-ambiguous.t new file mode 100644 index 0000000000..5ff63babdc --- /dev/null +++ b/tests/regression/46-apron2/87-unlock-idx-ambiguous.t @@ -0,0 +1,39 @@ + $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 87-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (87-unlock-idx-ambiguous.c:15:3-15:30) + [Success][Assert] Assertion "g == 0" will succeed (87-unlock-idx-ambiguous.c:25:3-25:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 87-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (87-unlock-idx-ambiguous.c:15:3-15:30) + [Success][Assert] Assertion "g == 0" will succeed (87-unlock-idx-ambiguous.c:25:3-25:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid-cluster12 --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 87-unlock-idx-ambiguous.c + [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (87-unlock-idx-ambiguous.c:15:3-15:30) + [Success][Assert] Assertion "g == 0" will succeed (87-unlock-idx-ambiguous.c:25:3-25:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + diff --git a/tests/regression/46-apron2/dune b/tests/regression/46-apron2/dune index cc0c04185c..f88a15d505 100644 --- a/tests/regression/46-apron2/dune +++ b/tests/regression/46-apron2/dune @@ -8,3 +8,6 @@ (glob_files ??-*.c)) (locks /update_suite) (action (chdir ../../.. (run %{update_suite} group apron2 -q)))) + +(cram + (deps (glob_files *.c))) From 9d32c70dbe8f336293b09da1550666203fd5ee45 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 15:18:34 +0300 Subject: [PATCH 062/107] Port base privatization non-definite mutex unlock unsoundness fix to relation --- src/analyses/apron/relationAnalysis.apron.ml | 34 +++++++++++++++---- .../46-apron2/87-unlock-idx-ambiguous.t | 6 ++-- 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 6c118dac7a..0431d19a3e 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -685,13 +685,35 @@ struct let st = ctx.local in match e with | Events.Lock (addr, _) when ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) - Priv.lock (Analyses.ask_of_ctx ctx) ctx.global st addr + begin match addr with + | UnknownPtr -> ctx.local + | Addr (v, _) when ctx.ask (IsMultiple v) -> ctx.local + | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> + Priv.lock (Analyses.ask_of_ctx ctx) ctx.global st addr + | _ -> ctx.local + end | Events.Unlock addr when ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) - if addr = UnknownPtr then - M.info ~category:Unsound "Unknown mutex unlocked, relation privatization unsound"; (* TODO: something more sound *) - WideningTokens.with_local_side_tokens (fun () -> - Priv.unlock (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st addr - ) + begin match addr with + | UnknownPtr -> + M.info ~category:Unsound "Unknown mutex unlocked, relation privatization unsound"; (* TODO: something more sound *) + ctx.local (* TODO: remove all! *) + | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> + WideningTokens.with_local_side_tokens (fun () -> + Priv.unlock (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st addr + ) + | Addr (v, o) -> + WideningTokens.with_local_side_tokens (fun () -> + let s = ctx.ask MustLockset in + LockDomain.MustLockset.fold (fun ml st -> + if LockDomain.MustLock.semantic_equal_mval ml (v, o) = Some false then + st + else + let addr = LockDomain.Addr.Addr (LockDomain.MustLock.to_mval ml) in + Priv.unlock (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st addr + ) s st + ) + | _ -> ctx.local + end | Events.EnterMultiThreaded -> Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st | Events.Escape escaped -> diff --git a/tests/regression/46-apron2/87-unlock-idx-ambiguous.t b/tests/regression/46-apron2/87-unlock-idx-ambiguous.t index 5ff63babdc..abbdd74f00 100644 --- a/tests/regression/46-apron2/87-unlock-idx-ambiguous.t +++ b/tests/regression/46-apron2/87-unlock-idx-ambiguous.t @@ -1,6 +1,6 @@ $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 87-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (87-unlock-idx-ambiguous.c:15:3-15:30) - [Success][Assert] Assertion "g == 0" will succeed (87-unlock-idx-ambiguous.c:25:3-25:26) + [Warning][Assert] Assertion "g == 0" is unknown. (87-unlock-idx-ambiguous.c:25:3-25:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 @@ -13,7 +13,7 @@ $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 87-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (87-unlock-idx-ambiguous.c:15:3-15:30) - [Success][Assert] Assertion "g == 0" will succeed (87-unlock-idx-ambiguous.c:25:3-25:26) + [Warning][Assert] Assertion "g == 0" is unknown. (87-unlock-idx-ambiguous.c:25:3-25:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 @@ -26,7 +26,7 @@ $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid-cluster12 --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 87-unlock-idx-ambiguous.c [Warning][Unknown] unlocking mutex (m[def_exc:Unknown int([0,1])]) which may not be held (87-unlock-idx-ambiguous.c:15:3-15:30) - [Success][Assert] Assertion "g == 0" will succeed (87-unlock-idx-ambiguous.c:25:3-25:26) + [Warning][Assert] Assertion "g == 0" is unknown. (87-unlock-idx-ambiguous.c:25:3-25:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 From 4caae9403f38049989689becb026137248c6c1de Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 15:42:26 +0300 Subject: [PATCH 063/107] Extract CommonPriv.lift_lock and lift_unlock --- src/analyses/apron/relationAnalysis.apron.ml | 41 ++++++-------------- src/analyses/base.ml | 36 ++++------------- src/analyses/commonPriv.ml | 27 +++++++++++++ 3 files changed, 46 insertions(+), 58 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 0431d19a3e..4a6b266c25 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -682,38 +682,19 @@ struct ctx.local let event ctx e octx = + let ask = Analyses.ask_of_ctx ctx in let st = ctx.local in match e with - | Events.Lock (addr, _) when ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) - begin match addr with - | UnknownPtr -> ctx.local - | Addr (v, _) when ctx.ask (IsMultiple v) -> ctx.local - | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> - Priv.lock (Analyses.ask_of_ctx ctx) ctx.global st addr - | _ -> ctx.local - end - | Events.Unlock addr when ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) - begin match addr with - | UnknownPtr -> - M.info ~category:Unsound "Unknown mutex unlocked, relation privatization unsound"; (* TODO: something more sound *) - ctx.local (* TODO: remove all! *) - | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> - WideningTokens.with_local_side_tokens (fun () -> - Priv.unlock (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st addr - ) - | Addr (v, o) -> - WideningTokens.with_local_side_tokens (fun () -> - let s = ctx.ask MustLockset in - LockDomain.MustLockset.fold (fun ml st -> - if LockDomain.MustLock.semantic_equal_mval ml (v, o) = Some false then - st - else - let addr = LockDomain.Addr.Addr (LockDomain.MustLock.to_mval ml) in - Priv.unlock (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st addr - ) s st - ) - | _ -> ctx.local - end + | Events.Lock (addr, _) when ThreadFlag.has_ever_been_multi ask -> (* TODO: is this condition sound? *) + CommonPriv.lift_lock ask (fun st m -> + Priv.lock ask ctx.global st m + ) st addr + | Events.Unlock addr when ThreadFlag.has_ever_been_multi ask -> (* TODO: is this condition sound? *) + WideningTokens.with_local_side_tokens (fun () -> + CommonPriv.lift_unlock ask (fun st m -> + Priv.unlock ask ctx.global ctx.sideg st m + ) st addr + ) | Events.EnterMultiThreaded -> Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st | Events.Escape escaped -> diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 13cf9f20da..fe4dc3e7de 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -3062,35 +3062,15 @@ struct match e with | Events.Lock (addr, _) when ThreadFlag.has_ever_been_multi ask -> (* TODO: is this condition sound? *) if M.tracing then M.tracel "priv" "LOCK EVENT %a" LockDomain.Addr.pretty addr; - begin match addr with - | UnknownPtr -> ctx.local - | Addr (v, _) when ctx.ask (IsMultiple v) -> ctx.local - | Addr (v, o) when Addr.Mval.is_definite (v, o) -> - Priv.lock ask (priv_getg ctx.global) st addr - | _ -> ctx.local - end + CommonPriv.lift_lock ask (fun st m -> + Priv.lock ask (priv_getg ctx.global) st m + ) st addr | Events.Unlock addr when ThreadFlag.has_ever_been_multi ask -> (* TODO: is this condition sound? *) - begin match addr with - | UnknownPtr -> - M.info ~category:Unsound "Unknown mutex unlocked, base privatization unsound"; (* TODO: something more sound *) - ctx.local (* TODO: remove all! *) - | Addr (v, o) when Addr.Mval.is_definite (v, o) -> - WideningTokens.with_local_side_tokens (fun () -> - Priv.unlock ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st addr - ) - | Addr (v, o) -> - WideningTokens.with_local_side_tokens (fun () -> - let s = ctx.ask MustLockset in - LockDomain.MustLockset.fold (fun ml st -> - if LockDomain.MustLock.semantic_equal_mval ml (v, o) = Some false then - st - else - let addr = Addr.Addr (LockDomain.MustLock.to_mval ml) in - Priv.unlock ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st addr - ) s st - ) - | _ -> ctx.local - end + WideningTokens.with_local_side_tokens (fun () -> + CommonPriv.lift_unlock ask (fun st m -> + Priv.unlock ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st m + ) st addr + ) | Events.Escape escaped -> Priv.escape ask (priv_getg ctx.global) (priv_sideg ctx.sideg) st escaped | Events.EnterMultiThreaded -> diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index aa829c4606..02ad65d8b6 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -305,3 +305,30 @@ struct let startstate () = W.bot (), LMust.top (), L.bot () end + + +let lift_lock (ask: Q.ask) f st (addr: LockDomain.Addr.t) = + match addr with + | UnknownPtr -> st + | Addr (v, _) when ask.f (IsMultiple v) -> st + | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> + f st addr + | _ -> st + +let lift_unlock (ask: Q.ask) f st (addr: LockDomain.Addr.t) = + match addr with + | UnknownPtr -> + M.info ~category:Unsound "Unknown mutex unlocked, privatization unsound"; (* TODO: something more sound *) + st (* TODO: remove all! *) + | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> + f st addr + | Addr (v, o) -> + let s = ask.f MustLockset in + LockDomain.MustLockset.fold (fun ml st -> + if LockDomain.MustLock.semantic_equal_mval ml (v, o) = Some false then + st + else + let addr = LockDomain.Addr.Addr (LockDomain.MustLock.to_mval ml) in + f st addr + ) s st + | _ -> st From ba3c020eb69b44ff7e1221f40103064c40ef3d0a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 15:54:35 +0300 Subject: [PATCH 064/107] Refactor CommonPriv.lift_lock and lift_unlock --- src/analyses/commonPriv.ml | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 02ad65d8b6..127dfe0383 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -308,27 +308,36 @@ end let lift_lock (ask: Q.ask) f st (addr: LockDomain.Addr.t) = + (* Should be in sync with: + 1. LocksetAnalysis.MakeMust.event + 2. MutexAnalysis.Spec.Arg.add + 3. LockDomain.MustLocksetRW.add_mval_rw *) match addr with | UnknownPtr -> st | Addr (v, _) when ask.f (IsMultiple v) -> st - | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> - f st addr - | _ -> st + | Addr mv when LockDomain.Mval.is_definite mv -> f st addr + | Addr _ + | NullPtr + | StrPtr _ -> st let lift_unlock (ask: Q.ask) f st (addr: LockDomain.Addr.t) = + (* Should be in sync with: + 1. LocksetAnalysis.MakeMust.event + 2. MutexAnalysis.Spec.Arg.remove + 3. MutexAnalysis.Spec.Arg.remove_all + 4. LockDomain.MustLocksetRW.remove_mval_rw *) match addr with | UnknownPtr -> M.info ~category:Unsound "Unknown mutex unlocked, privatization unsound"; (* TODO: something more sound *) st (* TODO: remove all! *) - | Addr (v, o) when LockDomain.Mval.is_definite (v, o) -> - f st addr - | Addr (v, o) -> - let s = ask.f MustLockset in + | StrPtr _ + | NullPtr -> st + | Addr mv when LockDomain.Mval.is_definite mv -> f st addr + | Addr mv -> LockDomain.MustLockset.fold (fun ml st -> - if LockDomain.MustLock.semantic_equal_mval ml (v, o) = Some false then + if LockDomain.MustLock.semantic_equal_mval ml mv = Some false then st else - let addr = LockDomain.Addr.Addr (LockDomain.MustLock.to_mval ml) in - f st addr - ) s st - | _ -> st + (* call privatization's unlock only with definite lock *) + f st (Addr (LockDomain.MustLock.to_mval ml)) (* TODO: no conversion *) + ) (ask.f MustLockset) st From 3dcf0c1c05173a5cb8dd7b4a7feb5e4235d4c542 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 16:00:46 +0300 Subject: [PATCH 065/107] Add unsound test for unlocking unknown mutex in privatizations --- .../13-privatized/94-unlock-unknown.c | 25 +++++++ .../13-privatized/94-unlock-unknown.t | 75 +++++++++++++++++++ .../regression/46-apron2/88-unlock-unknown.c | 25 +++++++ .../regression/46-apron2/88-unlock-unknown.t | 45 +++++++++++ 4 files changed, 170 insertions(+) create mode 100644 tests/regression/13-privatized/94-unlock-unknown.c create mode 100644 tests/regression/13-privatized/94-unlock-unknown.t create mode 100644 tests/regression/46-apron2/88-unlock-unknown.c create mode 100644 tests/regression/46-apron2/88-unlock-unknown.t diff --git a/tests/regression/13-privatized/94-unlock-unknown.c b/tests/regression/13-privatized/94-unlock-unknown.c new file mode 100644 index 0000000000..0897c38de8 --- /dev/null +++ b/tests/regression/13-privatized/94-unlock-unknown.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.base.privatization protection --enable ana.sv-comp.functions +#include +#include + +int g; +pthread_mutex_t m[2] = {PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER}; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m[0]); + g++; + pthread_mutex_t *r; // rand + pthread_mutex_unlock(r); + // could have unlocked m[0], so should have published g there + return NULL; +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + pthread_mutex_lock(&m[0]); + __goblint_check(g == 0); // UNKNOWN! + pthread_mutex_unlock(&m[0]); + return 0; +} diff --git a/tests/regression/13-privatized/94-unlock-unknown.t b/tests/regression/13-privatized/94-unlock-unknown.t new file mode 100644 index 0000000000..2d4e0d97cc --- /dev/null +++ b/tests/regression/13-privatized/94-unlock-unknown.t @@ -0,0 +1,75 @@ + $ goblint --set ana.base.privatization protection --enable ana.sv-comp.functions 94-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.base.privatization mutex-meet --enable ana.sv-comp.functions 94-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.base.privatization lock --enable ana.sv-comp.functions 94-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.base.privatization write --enable ana.sv-comp.functions 94-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.base.privatization mine-nothread --enable ana.sv-comp.functions 94-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + diff --git a/tests/regression/46-apron2/88-unlock-unknown.c b/tests/regression/46-apron2/88-unlock-unknown.c new file mode 100644 index 0000000000..3e09ee8659 --- /dev/null +++ b/tests/regression/46-apron2/88-unlock-unknown.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions +#include +#include + +int g; +pthread_mutex_t m[2] = {PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER}; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m[0]); + g++; + pthread_mutex_t *r; // rand + pthread_mutex_unlock(r); + // could have unlocked m[0], so should have published g there + return NULL; +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + pthread_mutex_lock(&m[0]); + __goblint_check(g == 0); // UNKNOWN! + pthread_mutex_unlock(&m[0]); + return 0; +} diff --git a/tests/regression/46-apron2/88-unlock-unknown.t b/tests/regression/46-apron2/88-unlock-unknown.t new file mode 100644 index 0000000000..f6649a116e --- /dev/null +++ b/tests/regression/46-apron2/88-unlock-unknown.t @@ -0,0 +1,45 @@ + $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions 88-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (88-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (88-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (88-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (88-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 88-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (88-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (88-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (88-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (88-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid-cluster12 --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 88-unlock-unknown.c + [Info][Unsound] Unknown mutex unlocked, privatization unsound (88-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (88-unlock-unknown.c:12:3-12:26) + [Warning][Unknown] unlocking NULL mutex (88-unlock-unknown.c:12:3-12:26) + [Success][Assert] Assertion "g == 0" will succeed (88-unlock-unknown.c:22:3-22:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + From fade1823f0f44e3e20cbb61522b276a4c538feb6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 16:02:51 +0300 Subject: [PATCH 066/107] Fix privatization unlocking unknown mutex unsoundness --- src/analyses/commonPriv.ml | 6 ++++-- .../regression/13-privatized/94-unlock-unknown.t | 15 +++++---------- tests/regression/46-apron2/88-unlock-unknown.t | 9 +++------ 3 files changed, 12 insertions(+), 18 deletions(-) diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 127dfe0383..fb5d0db142 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -328,8 +328,10 @@ let lift_unlock (ask: Q.ask) f st (addr: LockDomain.Addr.t) = 4. LockDomain.MustLocksetRW.remove_mval_rw *) match addr with | UnknownPtr -> - M.info ~category:Unsound "Unknown mutex unlocked, privatization unsound"; (* TODO: something more sound *) - st (* TODO: remove all! *) + LockDomain.MustLockset.fold (fun ml st -> + (* call privatization's unlock only with definite lock *) + f st (LockDomain.Addr.Addr (LockDomain.MustLock.to_mval ml)) (* TODO: no conversion *) + ) (ask.f MustLockset) st | StrPtr _ | NullPtr -> st | Addr mv when LockDomain.Mval.is_definite mv -> f st addr diff --git a/tests/regression/13-privatized/94-unlock-unknown.t b/tests/regression/13-privatized/94-unlock-unknown.t index 2d4e0d97cc..cc0aa921fe 100644 --- a/tests/regression/13-privatized/94-unlock-unknown.t +++ b/tests/regression/13-privatized/94-unlock-unknown.t @@ -1,8 +1,7 @@ $ goblint --set ana.base.privatization protection --enable ana.sv-comp.functions 94-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (94-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 @@ -14,10 +13,9 @@ total memory locations: 1 $ goblint --set ana.base.privatization mutex-meet --enable ana.sv-comp.functions 94-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (94-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 @@ -29,10 +27,9 @@ total memory locations: 1 $ goblint --set ana.base.privatization lock --enable ana.sv-comp.functions 94-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (94-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 @@ -44,10 +41,9 @@ total memory locations: 1 $ goblint --set ana.base.privatization write --enable ana.sv-comp.functions 94-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (94-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 @@ -59,10 +55,9 @@ total memory locations: 1 $ goblint --set ana.base.privatization mine-nothread --enable ana.sv-comp.functions 94-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (94-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (94-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (94-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (94-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 diff --git a/tests/regression/46-apron2/88-unlock-unknown.t b/tests/regression/46-apron2/88-unlock-unknown.t index f6649a116e..35e4ec4503 100644 --- a/tests/regression/46-apron2/88-unlock-unknown.t +++ b/tests/regression/46-apron2/88-unlock-unknown.t @@ -1,8 +1,7 @@ $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions 88-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (88-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (88-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (88-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (88-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (88-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 @@ -14,10 +13,9 @@ total memory locations: 1 $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 88-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (88-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (88-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (88-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (88-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (88-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 @@ -29,10 +27,9 @@ total memory locations: 1 $ goblint --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-tid-cluster12 --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag 88-unlock-unknown.c - [Info][Unsound] Unknown mutex unlocked, privatization unsound (88-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking unknown mutex which may not be held (88-unlock-unknown.c:12:3-12:26) [Warning][Unknown] unlocking NULL mutex (88-unlock-unknown.c:12:3-12:26) - [Success][Assert] Assertion "g == 0" will succeed (88-unlock-unknown.c:22:3-22:26) + [Warning][Assert] Assertion "g == 0" is unknown. (88-unlock-unknown.c:22:3-22:26) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 From 11526a831b47d0e408b4d56a2b0015f3e8c29978 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Tue, 4 Jun 2024 20:23:16 +0200 Subject: [PATCH 067/107] fix: narrow only when interval shrinks --- src/cdomain/value/cdomains/intDomain.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index f482842ca8..b882df732b 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -714,8 +714,8 @@ struct | Some (x1,x2), Some (y1,y2) -> let threshold = get_interval_threshold_widening () in let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 || threshold && IArith.is_lower_threshold x1 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 || threshold && IArith.is_upper_threshold x2 then y2 else x2 in + let lr = if Ints_t.compare min_ik x1 = 0 || threshold && Ints_t.compare y1 x1 > 0 && IArith.is_lower_threshold x1 then y1 else x1 in + let ur = if Ints_t.compare max_ik x2 = 0 || threshold && Ints_t.compare y2 x2 < 0 && IArith.is_upper_threshold x2 then y2 else x2 in norm ik @@ Some (lr,ur) |> fst From d6456c87b6a206bc73116a82d385fbfe48431fff Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Tue, 4 Jun 2024 20:32:37 +0200 Subject: [PATCH 068/107] narrow thresholds for int interval sets --- src/cdomain/value/cdomains/intDomain.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index b882df732b..7f91c9d036 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -1393,8 +1393,9 @@ struct let min_ys = minimal ys |> Option.get in let max_ys = maximal ys |> Option.get in let min_range,max_range = range ik in - let min = if min_xs =. min_range then min_ys else min_xs in - let max = if max_xs =. max_range then max_ys else max_xs in + let threshold = get_interval_threshold_widening () in + let min = if min_xs =. min_range || threshold && min_ys <. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in + let max = if max_xs =. max_range || threshold && max_ys <. max_xs && IArith.is_upper_threshold max_xs then max_ys else max_xs in xs |> (function (_, y)::z -> (min, y)::z | _ -> []) |> List.rev From 1e37e0b3a20c976ec89de5cd49618a3c70e5e58b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 5 Jun 2024 14:10:38 +0300 Subject: [PATCH 069/107] Use GobOption.exists instead of Option.is_some && Option.get --- src/cdomain/value/cdomains/valueDomain.ml | 15 ++++++++------- src/solver/generic.ml | 4 ++-- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/cdomain/value/cdomains/valueDomain.ml b/src/cdomain/value/cdomains/valueDomain.ml index de64fde807..be089f0ca5 100644 --- a/src/cdomain/value/cdomains/valueDomain.ml +++ b/src/cdomain/value/cdomains/valueDomain.ml @@ -978,8 +978,9 @@ struct let blob_size_opt = ID.to_int s in not @@ ask.is_multiple var && not @@ Cil.isVoidType t (* Size of value is known *) - && Option.is_some blob_size_opt (* Size of blob is known *) - && Z.equal (Option.get blob_size_opt) (Z.of_int @@ Cil.bitsSizeOf (TComp (toptype, []))/8) + && GobOption.exists (fun blob_size -> (* Size of blob is known *) + Z.equal blob_size (Z.of_int @@ Cil.bitsSizeOf (TComp (toptype, []))/8) + ) blob_size_opt | _ -> false in if do_strong_update then @@ -997,11 +998,11 @@ struct | (Var var, _) -> let blob_size_opt = ID.to_int s in not @@ ask.is_multiple var - && Option.is_some blob_size_opt (* Size of blob is known *) - && (( - not @@ Cil.isVoidType t (* Size of value is known *) - && Z.equal (Option.get blob_size_opt) (Z.of_int @@ Cil.alignOf_int t) - ) || blob_destructive) + && GobOption.exists (fun blob_size -> (* Size of blob is known *) + (not @@ Cil.isVoidType t (* Size of value is known *) + && Z.equal blob_size (Z.of_int @@ Cil.alignOf_int t)) + || blob_destructive + ) blob_size_opt | _ -> false end in diff --git a/src/solver/generic.ml b/src/solver/generic.ml index 1f0df57843..737aba6762 100644 --- a/src/solver/generic.ml +++ b/src/solver/generic.ml @@ -44,7 +44,7 @@ struct let histo = HM.create 1024 let increase (v:Var.t) = let set v c = - if not full_trace && (c > start_c && c > !max_c && (Option.is_none !max_var || not (Var.equal (Option.get !max_var) v))) then begin + if not full_trace && (c > start_c && c > !max_c && not (GobOption.exists (Var.equal v) !max_var)) then begin if tracing then trace "sol" "Switched tracing to %a" Var.pretty_trace v; max_c := c; max_var := Some v @@ -75,7 +75,7 @@ struct let update_var_event x o n = if tracing then increase x; - if full_trace || ((not (Dom.is_bot o)) && Option.is_some !max_var && Var.equal (Option.get !max_var) x) then begin + if full_trace || (not (Dom.is_bot o) && GobOption.exists (Var.equal x) !max_var) then begin if tracing then tracei "sol_max" "(%d) Update to %a" !max_c Var.pretty_trace x; if tracing then traceu "sol_max" "%a" Dom.pretty_diff (n, o) end From 67af68adb8834cf446cd24bdf41325db4de91b18 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 5 Jun 2024 14:11:13 +0300 Subject: [PATCH 070/107] Remove redundant match guard in condVars If is None, then body handles it anyway with Option.map and defaults to d. --- src/analyses/condVars.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/condVars.ml b/src/analyses/condVars.ml index 22b9db1cd4..448e3a79e5 100644 --- a/src/analyses/condVars.ml +++ b/src/analyses/condVars.ml @@ -116,7 +116,7 @@ struct match rval with | BinOp (op, _, _, _) when is_cmp op -> (* logical expression *) save_expr lval rval - | Lval k when Option.is_some (mustPointTo ctx (AddrOf k) >? flip D.get d) -> (* var-eq for transitive closure *) + | Lval k -> (* var-eq for transitive closure *) mustPointTo ctx (AddrOf k) >? flip D.get_elt d |> Option.map (save_expr lval) |? d | _ -> d From 3f8f8bf129dd26fc005422a3f43a07c5dfcc2b4b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 5 Jun 2024 14:12:03 +0300 Subject: [PATCH 071/107] Avoid intermediate lists in AddressSet.string_writing_defined Just check existance on set directly. --- src/cdomain/value/cdomains/addressDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomain/value/cdomains/addressDomain.ml b/src/cdomain/value/cdomains/addressDomain.ml index dc1ebfff7d..da684cc4f4 100644 --- a/src/cdomain/value/cdomains/addressDomain.ml +++ b/src/cdomain/value/cdomains/addressDomain.ml @@ -320,7 +320,7 @@ struct let string_writing_defined dest = (* if the destination address set contains a StrPtr, writing to such a string literal is undefined behavior *) - if List.exists Option.is_some (List.map Addr.to_c_string (elements dest)) then + if exists (fun a -> Option.is_some (Addr.to_c_string a)) dest then (M.warn ~category:M.Category.Behavior.Undefined.other "May write to a string literal, which leads to a segmentation fault in most cases"; false) else From ad73869770c75b3aa7ed144c605079d86026ee36 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Wed, 5 Jun 2024 13:51:10 +0200 Subject: [PATCH 072/107] integrate comments --- src/cdomain/value/cdomains/intDomain.ml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 7f91c9d036..a67740e9db 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -575,13 +575,11 @@ module IntervalArith (Ints_t : IntOps.IntOps) = struct let is_upper_threshold u = let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in let u = Ints_t.to_bigint u in - let t = List.find_opt (fun x -> Z.compare u x = 0) ts in - Option.is_some t + List.exists (fun x -> Z.compare u x = 0) ts let is_lower_threshold l = let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in let l = Ints_t.to_bigint l in - let t = List.find_opt (fun x -> Z.compare l x = 0) ts in - Option.is_some t + List.exists (fun x -> Z.compare l x = 0) ts end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = @@ -1394,7 +1392,7 @@ struct let max_ys = maximal ys |> Option.get in let min_range,max_range = range ik in let threshold = get_interval_threshold_widening () in - let min = if min_xs =. min_range || threshold && min_ys <. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in + let min = if min_xs =. min_range || threshold && min_ys >. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in let max = if max_xs =. max_range || threshold && max_ys <. max_xs && IArith.is_upper_threshold max_xs then max_ys else max_xs in xs |> (function (_, y)::z -> (min, y)::z | _ -> []) From 94a31d4ef61f6e4227c0329f96342ae1f471eeb5 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Wed, 5 Jun 2024 14:53:00 +0200 Subject: [PATCH 073/107] test interval-set narrowing and lower bounds --- ...rrowing.c => 33-threshold-narrowing-intervals.c} | 5 +++++ .../34-threshold-narrowing-interval-sets.c | 13 +++++++++++++ 2 files changed, 18 insertions(+) rename tests/regression/03-practical/{33-threshold-narrowing.c => 33-threshold-narrowing-intervals.c} (74%) create mode 100644 tests/regression/03-practical/34-threshold-narrowing-interval-sets.c diff --git a/tests/regression/03-practical/33-threshold-narrowing.c b/tests/regression/03-practical/33-threshold-narrowing-intervals.c similarity index 74% rename from tests/regression/03-practical/33-threshold-narrowing.c rename to tests/regression/03-practical/33-threshold-narrowing-intervals.c index 0c713fa273..ef38c151da 100644 --- a/tests/regression/03-practical/33-threshold-narrowing.c +++ b/tests/regression/03-practical/33-threshold-narrowing-intervals.c @@ -5,4 +5,9 @@ int main() { int i; for(i = 0; i < 10 && i < 20; i += 3); __goblint_check(i <= 12); + + int j; + for(j = 0; j > -10 && j > -20; j-= 3); + __goblint_check(j >= -12); + } diff --git a/tests/regression/03-practical/34-threshold-narrowing-interval-sets.c b/tests/regression/03-practical/34-threshold-narrowing-interval-sets.c new file mode 100644 index 0000000000..c1f11c091e --- /dev/null +++ b/tests/regression/03-practical/34-threshold-narrowing-interval-sets.c @@ -0,0 +1,13 @@ +// PARAM: --enable ana.int.interval_set --enable ana.int.interval_threshold_widening --set ana.int.interval_threshold_widening_constants comparisons +#include + +int main() { + int i; + for(i = 0; i < 10 && i < 20; i += 3); + __goblint_check(i <= 12); + + int j; + for(j = 0; j > -10 && j > -20; j-= 3); + __goblint_check(j >= -12); + +} From 8aa9c4f4f0be045e0ba0363dd12bc72790907a27 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Wed, 5 Jun 2024 14:54:16 +0200 Subject: [PATCH 074/107] add unit test for interval(-set) narrowing --- tests/unit/cdomains/intDomainTest.ml | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/tests/unit/cdomains/intDomainTest.ml b/tests/unit/cdomains/intDomainTest.ml index e697b022eb..a60b7a6cb1 100644 --- a/tests/unit/cdomains/intDomainTest.ml +++ b/tests/unit/cdomains/intDomainTest.ml @@ -205,6 +205,7 @@ struct let i65536 = I.of_interval ik (Z.zero, of_int 65536) let i65537 = I.of_interval ik (Z.zero, of_int 65537) let imax = I.of_interval ik (Z.zero, of_int 2147483647) + let imin = I.of_interval ik (of_int (-2147483648), Z.zero) let assert_equal x y = assert_equal ~cmp:I.equal ~printer:I.show x y @@ -218,9 +219,34 @@ struct assert_equal imax (I.widen ik i65536 i65537); assert_equal imax (I.widen ik i65536 imax) + let test_interval_narrow _ = + GobConfig.set_bool "ana.int.interval_threshold_widening" true; + GobConfig.set_string "ana.int.interval_threshold_widening_constants" "comparisons"; + let i_zero_one = I.of_interval ik (Z.zero, Z.one) in + let i_zero_five = I.of_interval ik (Z.zero, of_int 5) in + let to_widen = I.of_interval ik (Z.zero, Z.zero) in + (* this should widen to [0, x], where x is the next largest threshold above 5 or the maximal int*) + let widened = I.widen ik to_widen i_zero_five in + (* either way, narrowing from [0, x] to [0, 1] should be possible *) + let narrowed = I.narrow ik widened i_zero_one in + (* however, narrowing should not allow [0, x] to grow *) + let narrowed2 = I.narrow ik widened imax in + assert_equal i_zero_one narrowed; + assert_equal widened narrowed2; + + (* the same tests, but for lower bounds *) + let i_minus_one_zero = I.of_interval ik (Z.minus_one, Z.zero) in + let i_minus_five_zero = I.of_interval ik (of_int (-5), Z.zero) in + let widened = I.widen ik to_widen i_minus_five_zero in + let narrowed = I.narrow ik widened i_minus_one_zero in + let narrowed2 = I.narrow ik widened imin in + assert_equal i_minus_one_zero narrowed; + assert_equal widened narrowed2 + let test () = [ "test_interval_rem" >:: test_interval_rem; "test_interval_widen" >:: test_interval_widen; + "test_interval_narrow" >:: test_interval_narrow; ] end From a384886cd8424cbdada153072647a68c703c789b Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Wed, 5 Jun 2024 18:58:45 +0300 Subject: [PATCH 075/107] Make `to_float` return float instead float option --- src/cdomain/value/cdomains/floatDomain.ml | 4 ++-- src/common/cdomains/floatOps/floatOps.ml | 6 ++--- src/common/cdomains/floatOps/floatOps.mli | 2 +- tests/unit/cdomains/floatDomainTest.ml | 28 +++++++++++------------ 4 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/cdomain/value/cdomains/floatDomain.ml b/src/cdomain/value/cdomains/floatDomain.ml index c86770826c..0977c68890 100644 --- a/src/cdomain/value/cdomains/floatDomain.ml +++ b/src/cdomain/value/cdomains/floatDomain.ml @@ -241,12 +241,12 @@ module FloatIntervalImpl(Float_t : CFloatType) = struct let minimal = function | Bot -> raise (ArithmeticOnFloatBot (Printf.sprintf "minimal %s" (show Bot))) - | Interval (l, _) -> Float_t.to_float l + | Interval (l, _) -> Some (Float_t.to_float l) | _ -> None let maximal = function | Bot -> raise (ArithmeticOnFloatBot (Printf.sprintf "maximal %s" (show Bot))) - | Interval (_, h) -> Float_t.to_float h + | Interval (_, h) -> Some (Float_t.to_float h) | _ -> None let is_exact = function diff --git a/src/common/cdomains/floatOps/floatOps.ml b/src/common/cdomains/floatOps/floatOps.ml index 80946b1749..eced6af248 100644 --- a/src/common/cdomains/floatOps/floatOps.ml +++ b/src/common/cdomains/floatOps/floatOps.ml @@ -16,7 +16,7 @@ module type CFloatType = sig val pi : t val of_float: round_mode -> float -> t - val to_float: t -> float option + val to_float: t -> float val to_big_int: t -> Z.t val is_finite: t -> bool @@ -68,7 +68,7 @@ module CDouble = struct let pi = Float.pi let of_float _ x = x - let to_float x = Some x + let to_float x = x let to_big_int = big_int_of_float let is_finite = Float.is_finite @@ -112,7 +112,7 @@ module CFloat = struct let smallest = smallest' () let pi = pi' () - let to_float x = Some x + let to_float x = x let to_big_int = big_int_of_float let is_finite x = Float.is_finite x && x >= lower_bound && x <= upper_bound diff --git a/src/common/cdomains/floatOps/floatOps.mli b/src/common/cdomains/floatOps/floatOps.mli index 7cd74f7e7d..a07582f442 100644 --- a/src/common/cdomains/floatOps/floatOps.mli +++ b/src/common/cdomains/floatOps/floatOps.mli @@ -17,7 +17,7 @@ module type CFloatType = sig val pi : t val of_float: round_mode -> float -> t - val to_float: t -> float option + val to_float: t -> float val to_big_int: t -> Z.t val is_finite: t -> bool diff --git a/tests/unit/cdomains/floatDomainTest.ml b/tests/unit/cdomains/floatDomainTest.ml index 5f3cd4db47..c6cb18500a 100644 --- a/tests/unit/cdomains/floatDomainTest.ml +++ b/tests/unit/cdomains/floatDomainTest.ml @@ -14,12 +14,12 @@ struct let mul = Float_t.mul let div = Float_t.div - let pred x = Option.get (to_float (Float_t.pred (of_float Nearest x))) - let succ x = Option.get (to_float (Float_t.succ (of_float Nearest x))) + let pred x = to_float (Float_t.pred (of_float Nearest x)) + let succ x = to_float (Float_t.succ (of_float Nearest x)) - let fmax = Option.get (to_float Float_t.upper_bound) - let fmin = Option.get (to_float Float_t.lower_bound) - let fsmall = Option.get (to_float Float_t.smallest) + let fmax = to_float Float_t.upper_bound + let fmin = to_float Float_t.lower_bound + let fsmall = to_float Float_t.smallest let fi_zero = FI.of_const 0. let fi_one = FI.of_const 1. @@ -53,7 +53,7 @@ struct FI.top () + FI.top () = FI.top (); (FI.of_const fmin) + (FI.of_const fmax) = fi_zero; (FI.of_const fsmall) + (FI.of_const fsmall) = FI.of_const (fsmall +. fsmall); - let one_plus_fsmall = Option.get (to_float (Float_t.add Up (Float_t.of_float Up 1.) Float_t.smallest)) in + let one_plus_fsmall = to_float (Float_t.add Up (Float_t.of_float Up 1.) Float_t.smallest) in (FI.of_const fsmall) + (FI.of_const 1.) = FI.of_interval (1., one_plus_fsmall); (FI.of_interval (1., 2.)) + (FI.of_interval (2., 3.)) = FI.of_interval (3., 5.); (FI.of_interval (-. 2., 3.)) + (FI.of_interval (-. 100., 20.)) = FI.of_interval (-. 102., 23.); @@ -286,27 +286,27 @@ struct let test_FI_add = QCheck.Test.make ~name:"test_FI_add" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.add (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (Option.get (to_float (add Up (of_float Nearest arg1) (of_float Nearest arg2))))) result) && - (FI.leq (FI.of_const (Option.get (to_float (add Down (of_float Nearest arg1) (of_float Nearest arg2))))) result)) + (FI.leq (FI.of_const (to_float (add Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (add Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) let test_FI_sub = QCheck.Test.make ~name:"test_FI_sub" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.sub (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (Option.get (to_float (sub Up (of_float Nearest arg1) (of_float Nearest arg2))))) result) && - (FI.leq (FI.of_const (Option.get (to_float (sub Down (of_float Nearest arg1) (of_float Nearest arg2))))) result)) + (FI.leq (FI.of_const (to_float (sub Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (sub Down (of_float Nearest arg1) (of_float Nearest arg2))))) result) let test_FI_mul = QCheck.Test.make ~name:"test_FI_mul" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.mul (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (Option.get (to_float (mul Up (of_float Nearest arg1) (of_float Nearest arg2))))) result) && - (FI.leq (FI.of_const (Option.get (to_float (mul Down (of_float Nearest arg1) (of_float Nearest arg2))))) result)) + (FI.leq (FI.of_const (to_float (mul Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (mul Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) let test_FI_div = QCheck.Test.make ~name:"test_FI_div" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.div (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (Option.get (to_float (div Up (of_float Nearest arg1) (of_float Nearest arg2))))) result) && - (FI.leq (FI.of_const (Option.get (to_float (div Down (of_float Nearest arg1) (of_float Nearest arg2))))) result)) + (FI.leq (FI.of_const (to_float (div Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (div Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) let test () = [ From 1cbf7aca72bfbc8073a223f13723080b0d3c67ac Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Wed, 5 Jun 2024 19:13:38 +0300 Subject: [PATCH 076/107] Define CFloatType t = float --- src/common/cdomains/floatOps/floatOps.ml | 4 ++-- src/common/cdomains/floatOps/floatOps.mli | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/common/cdomains/floatOps/floatOps.ml b/src/common/cdomains/floatOps/floatOps.ml index eced6af248..002f382aff 100644 --- a/src/common/cdomains/floatOps/floatOps.ml +++ b/src/common/cdomains/floatOps/floatOps.ml @@ -6,7 +6,7 @@ type round_mode = | Down module type CFloatType = sig - type t + type t = float val name: string val zero: t @@ -97,7 +97,7 @@ module CDouble = struct external atof: round_mode -> string -> t = "atof_double" end -module CFloat = struct +module CFloat : CFloatType = struct type t = float [@@deriving eq, ord, hash, to_yojson] let name = "float" diff --git a/src/common/cdomains/floatOps/floatOps.mli b/src/common/cdomains/floatOps/floatOps.mli index a07582f442..f45785a7d5 100644 --- a/src/common/cdomains/floatOps/floatOps.mli +++ b/src/common/cdomains/floatOps/floatOps.mli @@ -7,7 +7,7 @@ type round_mode = | Down module type CFloatType = sig - type t + type t = float val name: string val zero: t From 87f60f3b16b25261b29f3e999cc7d53b90ade7da Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Wed, 5 Jun 2024 19:27:10 +0300 Subject: [PATCH 077/107] Remove identity function `to_float` --- src/cdomain/value/cdomains/floatDomain.ml | 4 ++-- src/common/cdomains/floatOps/floatOps.ml | 3 --- src/common/cdomains/floatOps/floatOps.mli | 1 - tests/unit/cdomains/floatDomainTest.ml | 29 +++++++++++------------ 4 files changed, 16 insertions(+), 21 deletions(-) diff --git a/src/cdomain/value/cdomains/floatDomain.ml b/src/cdomain/value/cdomains/floatDomain.ml index 0977c68890..db6e4eccb5 100644 --- a/src/cdomain/value/cdomains/floatDomain.ml +++ b/src/cdomain/value/cdomains/floatDomain.ml @@ -241,12 +241,12 @@ module FloatIntervalImpl(Float_t : CFloatType) = struct let minimal = function | Bot -> raise (ArithmeticOnFloatBot (Printf.sprintf "minimal %s" (show Bot))) - | Interval (l, _) -> Some (Float_t.to_float l) + | Interval (l, _) -> Some l | _ -> None let maximal = function | Bot -> raise (ArithmeticOnFloatBot (Printf.sprintf "maximal %s" (show Bot))) - | Interval (_, h) -> Some (Float_t.to_float h) + | Interval (_, h) -> Some h | _ -> None let is_exact = function diff --git a/src/common/cdomains/floatOps/floatOps.ml b/src/common/cdomains/floatOps/floatOps.ml index 002f382aff..6088fa9447 100644 --- a/src/common/cdomains/floatOps/floatOps.ml +++ b/src/common/cdomains/floatOps/floatOps.ml @@ -16,7 +16,6 @@ module type CFloatType = sig val pi : t val of_float: round_mode -> float -> t - val to_float: t -> float val to_big_int: t -> Z.t val is_finite: t -> bool @@ -68,7 +67,6 @@ module CDouble = struct let pi = Float.pi let of_float _ x = x - let to_float x = x let to_big_int = big_int_of_float let is_finite = Float.is_finite @@ -112,7 +110,6 @@ module CFloat : CFloatType = struct let smallest = smallest' () let pi = pi' () - let to_float x = x let to_big_int = big_int_of_float let is_finite x = Float.is_finite x && x >= lower_bound && x <= upper_bound diff --git a/src/common/cdomains/floatOps/floatOps.mli b/src/common/cdomains/floatOps/floatOps.mli index f45785a7d5..2deb55a764 100644 --- a/src/common/cdomains/floatOps/floatOps.mli +++ b/src/common/cdomains/floatOps/floatOps.mli @@ -17,7 +17,6 @@ module type CFloatType = sig val pi : t val of_float: round_mode -> float -> t - val to_float: t -> float val to_big_int: t -> Z.t val is_finite: t -> bool diff --git a/tests/unit/cdomains/floatDomainTest.ml b/tests/unit/cdomains/floatDomainTest.ml index c6cb18500a..6b49d21a1a 100644 --- a/tests/unit/cdomains/floatDomainTest.ml +++ b/tests/unit/cdomains/floatDomainTest.ml @@ -7,19 +7,18 @@ struct module FI = Domain_t module IT = IntDomain.IntDomTuple - let to_float = Float_t.to_float let of_float = Float_t.of_float let add = Float_t.add let sub = Float_t.sub let mul = Float_t.mul let div = Float_t.div - let pred x = to_float (Float_t.pred (of_float Nearest x)) - let succ x = to_float (Float_t.succ (of_float Nearest x)) + let pred x = Float_t.pred (of_float Nearest x) + let succ x = Float_t.succ (of_float Nearest x) - let fmax = to_float Float_t.upper_bound - let fmin = to_float Float_t.lower_bound - let fsmall = to_float Float_t.smallest + let fmax = Float_t.upper_bound + let fmin = Float_t.lower_bound + let fsmall = Float_t.smallest let fi_zero = FI.of_const 0. let fi_one = FI.of_const 1. @@ -53,7 +52,7 @@ struct FI.top () + FI.top () = FI.top (); (FI.of_const fmin) + (FI.of_const fmax) = fi_zero; (FI.of_const fsmall) + (FI.of_const fsmall) = FI.of_const (fsmall +. fsmall); - let one_plus_fsmall = to_float (Float_t.add Up (Float_t.of_float Up 1.) Float_t.smallest) in + let one_plus_fsmall = Float_t.add Up (Float_t.of_float Up 1.) Float_t.smallest in (FI.of_const fsmall) + (FI.of_const 1.) = FI.of_interval (1., one_plus_fsmall); (FI.of_interval (1., 2.)) + (FI.of_interval (2., 3.)) = FI.of_interval (3., 5.); (FI.of_interval (-. 2., 3.)) + (FI.of_interval (-. 100., 20.)) = FI.of_interval (-. 102., 23.); @@ -286,27 +285,27 @@ struct let test_FI_add = QCheck.Test.make ~name:"test_FI_add" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.add (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (to_float (add Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && - (FI.leq (FI.of_const (to_float (add Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) + (FI.leq (FI.of_const (add Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && + (FI.leq (FI.of_const (add Down (of_float Nearest arg1) (of_float Nearest arg2))) result)) let test_FI_sub = QCheck.Test.make ~name:"test_FI_sub" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.sub (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (to_float (sub Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && - (FI.leq (FI.of_const (to_float (sub Down (of_float Nearest arg1) (of_float Nearest arg2))))) result) + (FI.leq (FI.of_const (sub Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && + (FI.leq (FI.of_const (sub Down (of_float Nearest arg1) (of_float Nearest arg2)))) result) let test_FI_mul = QCheck.Test.make ~name:"test_FI_mul" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.mul (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (to_float (mul Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && - (FI.leq (FI.of_const (to_float (mul Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) + (FI.leq (FI.of_const (mul Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && + (FI.leq (FI.of_const (mul Down (of_float Nearest arg1) (of_float Nearest arg2))) result)) let test_FI_div = QCheck.Test.make ~name:"test_FI_div" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.div (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (to_float (div Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && - (FI.leq (FI.of_const (to_float (div Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) + (FI.leq (FI.of_const (div Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && + (FI.leq (FI.of_const (div Down (of_float Nearest arg1) (of_float Nearest arg2))) result)) let test () = [ From f990f47f0baec95a744e3784ceadcce7f6b0e2cd Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Thu, 6 Jun 2024 12:40:44 +0300 Subject: [PATCH 078/107] Replace usages of `Option.get` with `Option.fold` --- src/cdomain/value/cdomains/intDomain.ml | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 3bf81b1ba1..f0ba026ccb 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -2256,9 +2256,8 @@ struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let x_min = minimal x in - let y_min = minimal y in - if x_min = None || y_min = None || Z.compare (Option.get x_min) Z.zero < 0 || Z.compare (Option.get y_min) Z.zero < 0 then + let is_negative = Stdlib.Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in + if is_negative (minimal x) || is_negative (minimal y) then top_of ik else norm ik @@ lift2 shift_op_big_int ik x y @@ -2616,9 +2615,8 @@ module Enums : S with type int_t = Z.t = struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let x_min = minimal x in - let y_min = minimal y in - if x_min = None || y_min = None || Z.compare (Option.get x_min) Z.zero < 0 || Z.compare (Option.get y_min) Z.zero < 0 then + let is_negative = Stdlib.Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in + if is_negative (minimal x) || is_negative (minimal y) then top_of ik else lift2 shift_op_big_int ik x y) From d61ec3e2ee08e8595828abad3964fb95f176b855 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Thu, 6 Jun 2024 12:45:19 +0300 Subject: [PATCH 079/107] Remove `open Batteries` --- src/cdomain/value/cdomains/intDomain.ml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index f0ba026ccb..69125a0d7a 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -2256,7 +2256,7 @@ struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = Stdlib.Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in + let is_negative = Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in if is_negative (minimal x) || is_negative (minimal y) then top_of ik else @@ -2403,7 +2403,6 @@ module Booleans = MakeBooleans ( (* Inclusion/Exclusion sets. Go to top on arithmetic operations (except for some easy cases, e.g. multiplication with 0). Joins on widen, i.e. precise integers as long as not derived from arithmetic expressions. *) module Enums : S with type int_t = Z.t = struct - open Batteries module R = Interval32 (* range for exclusion *) let range_ikind = Cil.IInt @@ -2513,7 +2512,8 @@ module Enums : S with type int_t = Z.t = struct let ex = if Z.gt x Z.zero || Z.lt y Z.zero then BISet.singleton Z.zero else BISet.empty () in norm ik @@ (Exc (ex, r)) - let join ik = curry @@ function + let join _ x y = + match x, y with | Inc x, Inc y -> Inc (BISet.union x y) | Exc (x,r1), Exc (y,r2) -> Exc (BISet.inter x y, R.join r1 r2) | Exc (x,r), Inc y @@ -2521,13 +2521,14 @@ module Enums : S with type int_t = Z.t = struct let r = if BISet.is_empty y then r else - let (min_el_range, max_el_range) = Tuple2.mapn (fun x -> R.of_interval range_ikind (Size.min_range_sign_agnostic x)) (BISet.min_elt y, BISet.max_elt y) in + let (min_el_range, max_el_range) = Batteries.Tuple2.mapn (fun x -> R.of_interval range_ikind (Size.min_range_sign_agnostic x)) (BISet.min_elt y, BISet.max_elt y) in let range = R.join min_el_range max_el_range in R.join r range in Exc (BISet.diff x y, r) - let meet ikind = curry @@ function + let meet _ x y = + match x, y with | Inc x, Inc y -> Inc (BISet.inter x y) | Exc (x,r1), Exc (y,r2) -> let r = R.meet r1 r2 in @@ -2581,7 +2582,8 @@ module Enums : S with type int_t = Z.t = struct try lift2 f ikind a b with Division_by_zero -> top_of ikind let neg ?no_ov = lift1 Z.neg - let add ?no_ov ikind = curry @@ function + let add ?no_ov ikind a b = + match a, b with | Inc z,x when BISet.is_singleton z && BISet.choose z = Z.zero -> x | x,Inc z when BISet.is_singleton z && BISet.choose z = Z.zero -> x | x,y -> lift2 Z.add ikind x y @@ -2615,7 +2617,7 @@ module Enums : S with type int_t = Z.t = struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = Stdlib.Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in + let is_negative = Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in if is_negative (minimal x) || is_negative (minimal y) then top_of ik else From a3d43f673debd47eb5d95c7b2d1cdf1bdd9cf8a3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 6 Jun 2024 13:31:43 +0300 Subject: [PATCH 080/107] Add SKIP to Apron tests (PR #1500) --- tests/regression/46-apron2/87-unlock-idx-ambiguous.c | 2 +- tests/regression/46-apron2/88-unlock-unknown.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/46-apron2/87-unlock-idx-ambiguous.c b/tests/regression/46-apron2/87-unlock-idx-ambiguous.c index 97cada5369..ff6461217e 100644 --- a/tests/regression/46-apron2/87-unlock-idx-ambiguous.c +++ b/tests/regression/46-apron2/87-unlock-idx-ambiguous.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag +// SKIP PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions --set ana.path_sens[+] threadflag // TODO: why nonterm without threadflag path-sens? #include #include diff --git a/tests/regression/46-apron2/88-unlock-unknown.c b/tests/regression/46-apron2/88-unlock-unknown.c index 3e09ee8659..dbdc4b9f77 100644 --- a/tests/regression/46-apron2/88-unlock-unknown.c +++ b/tests/regression/46-apron2/88-unlock-unknown.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions +// SKIP PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --enable ana.sv-comp.functions #include #include From 8998e4776338305956ac6681fb751ba2a0e6bcba Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 6 Jun 2024 17:37:39 +0300 Subject: [PATCH 081/107] Add enabled_if to Apron cram tests (PR #1500) --- tests/regression/46-apron2/dune | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/regression/46-apron2/dune b/tests/regression/46-apron2/dune index f88a15d505..89efde3083 100644 --- a/tests/regression/46-apron2/dune +++ b/tests/regression/46-apron2/dune @@ -10,4 +10,6 @@ (action (chdir ../../.. (run %{update_suite} group apron2 -q)))) (cram + (alias runaprontest) + (enabled_if %{lib-available:apron}) (deps (glob_files *.c))) From 36328e613fce1d102c99aae01b0ae4022c822e72 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Mon, 10 Jun 2024 12:49:02 +0300 Subject: [PATCH 082/107] Revert "Define CFloatType t = float" This reverts commit 1cbf7aca72bfbc8073a223f13723080b0d3c67ac. --- src/common/cdomains/floatOps/floatOps.ml | 4 ++-- src/common/cdomains/floatOps/floatOps.mli | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/common/cdomains/floatOps/floatOps.ml b/src/common/cdomains/floatOps/floatOps.ml index 6088fa9447..214b0d6c04 100644 --- a/src/common/cdomains/floatOps/floatOps.ml +++ b/src/common/cdomains/floatOps/floatOps.ml @@ -6,7 +6,7 @@ type round_mode = | Down module type CFloatType = sig - type t = float + type t val name: string val zero: t @@ -95,7 +95,7 @@ module CDouble = struct external atof: round_mode -> string -> t = "atof_double" end -module CFloat : CFloatType = struct +module CFloat = struct type t = float [@@deriving eq, ord, hash, to_yojson] let name = "float" diff --git a/src/common/cdomains/floatOps/floatOps.mli b/src/common/cdomains/floatOps/floatOps.mli index 2deb55a764..f956fe426d 100644 --- a/src/common/cdomains/floatOps/floatOps.mli +++ b/src/common/cdomains/floatOps/floatOps.mli @@ -7,7 +7,7 @@ type round_mode = | Down module type CFloatType = sig - type t = float + type t val name: string val zero: t From 682ce29f7a356abb269ded03e9bfcf0030f6ca3b Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Mon, 10 Jun 2024 12:49:10 +0300 Subject: [PATCH 083/107] Revert "Remove identity function `to_float`" This reverts commit 87f60f3b16b25261b29f3e999cc7d53b90ade7da. --- src/cdomain/value/cdomains/floatDomain.ml | 4 ++-- src/common/cdomains/floatOps/floatOps.ml | 3 +++ src/common/cdomains/floatOps/floatOps.mli | 1 + tests/unit/cdomains/floatDomainTest.ml | 29 ++++++++++++----------- 4 files changed, 21 insertions(+), 16 deletions(-) diff --git a/src/cdomain/value/cdomains/floatDomain.ml b/src/cdomain/value/cdomains/floatDomain.ml index db6e4eccb5..0977c68890 100644 --- a/src/cdomain/value/cdomains/floatDomain.ml +++ b/src/cdomain/value/cdomains/floatDomain.ml @@ -241,12 +241,12 @@ module FloatIntervalImpl(Float_t : CFloatType) = struct let minimal = function | Bot -> raise (ArithmeticOnFloatBot (Printf.sprintf "minimal %s" (show Bot))) - | Interval (l, _) -> Some l + | Interval (l, _) -> Some (Float_t.to_float l) | _ -> None let maximal = function | Bot -> raise (ArithmeticOnFloatBot (Printf.sprintf "maximal %s" (show Bot))) - | Interval (_, h) -> Some h + | Interval (_, h) -> Some (Float_t.to_float h) | _ -> None let is_exact = function diff --git a/src/common/cdomains/floatOps/floatOps.ml b/src/common/cdomains/floatOps/floatOps.ml index 214b0d6c04..eced6af248 100644 --- a/src/common/cdomains/floatOps/floatOps.ml +++ b/src/common/cdomains/floatOps/floatOps.ml @@ -16,6 +16,7 @@ module type CFloatType = sig val pi : t val of_float: round_mode -> float -> t + val to_float: t -> float val to_big_int: t -> Z.t val is_finite: t -> bool @@ -67,6 +68,7 @@ module CDouble = struct let pi = Float.pi let of_float _ x = x + let to_float x = x let to_big_int = big_int_of_float let is_finite = Float.is_finite @@ -110,6 +112,7 @@ module CFloat = struct let smallest = smallest' () let pi = pi' () + let to_float x = x let to_big_int = big_int_of_float let is_finite x = Float.is_finite x && x >= lower_bound && x <= upper_bound diff --git a/src/common/cdomains/floatOps/floatOps.mli b/src/common/cdomains/floatOps/floatOps.mli index f956fe426d..a07582f442 100644 --- a/src/common/cdomains/floatOps/floatOps.mli +++ b/src/common/cdomains/floatOps/floatOps.mli @@ -17,6 +17,7 @@ module type CFloatType = sig val pi : t val of_float: round_mode -> float -> t + val to_float: t -> float val to_big_int: t -> Z.t val is_finite: t -> bool diff --git a/tests/unit/cdomains/floatDomainTest.ml b/tests/unit/cdomains/floatDomainTest.ml index 6b49d21a1a..c6cb18500a 100644 --- a/tests/unit/cdomains/floatDomainTest.ml +++ b/tests/unit/cdomains/floatDomainTest.ml @@ -7,18 +7,19 @@ struct module FI = Domain_t module IT = IntDomain.IntDomTuple + let to_float = Float_t.to_float let of_float = Float_t.of_float let add = Float_t.add let sub = Float_t.sub let mul = Float_t.mul let div = Float_t.div - let pred x = Float_t.pred (of_float Nearest x) - let succ x = Float_t.succ (of_float Nearest x) + let pred x = to_float (Float_t.pred (of_float Nearest x)) + let succ x = to_float (Float_t.succ (of_float Nearest x)) - let fmax = Float_t.upper_bound - let fmin = Float_t.lower_bound - let fsmall = Float_t.smallest + let fmax = to_float Float_t.upper_bound + let fmin = to_float Float_t.lower_bound + let fsmall = to_float Float_t.smallest let fi_zero = FI.of_const 0. let fi_one = FI.of_const 1. @@ -52,7 +53,7 @@ struct FI.top () + FI.top () = FI.top (); (FI.of_const fmin) + (FI.of_const fmax) = fi_zero; (FI.of_const fsmall) + (FI.of_const fsmall) = FI.of_const (fsmall +. fsmall); - let one_plus_fsmall = Float_t.add Up (Float_t.of_float Up 1.) Float_t.smallest in + let one_plus_fsmall = to_float (Float_t.add Up (Float_t.of_float Up 1.) Float_t.smallest) in (FI.of_const fsmall) + (FI.of_const 1.) = FI.of_interval (1., one_plus_fsmall); (FI.of_interval (1., 2.)) + (FI.of_interval (2., 3.)) = FI.of_interval (3., 5.); (FI.of_interval (-. 2., 3.)) + (FI.of_interval (-. 100., 20.)) = FI.of_interval (-. 102., 23.); @@ -285,27 +286,27 @@ struct let test_FI_add = QCheck.Test.make ~name:"test_FI_add" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.add (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (add Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && - (FI.leq (FI.of_const (add Down (of_float Nearest arg1) (of_float Nearest arg2))) result)) + (FI.leq (FI.of_const (to_float (add Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (add Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) let test_FI_sub = QCheck.Test.make ~name:"test_FI_sub" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.sub (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (sub Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && - (FI.leq (FI.of_const (sub Down (of_float Nearest arg1) (of_float Nearest arg2)))) result) + (FI.leq (FI.of_const (to_float (sub Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (sub Down (of_float Nearest arg1) (of_float Nearest arg2))))) result) let test_FI_mul = QCheck.Test.make ~name:"test_FI_mul" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.mul (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (mul Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && - (FI.leq (FI.of_const (mul Down (of_float Nearest arg1) (of_float Nearest arg2))) result)) + (FI.leq (FI.of_const (to_float (mul Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (mul Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) let test_FI_div = QCheck.Test.make ~name:"test_FI_div" (QCheck.pair QCheck.float QCheck.float) (fun (arg1, arg2) -> let result = FI.div (FI.of_const arg1) (FI.of_const arg2) in - (FI.leq (FI.of_const (div Up (of_float Nearest arg1) (of_float Nearest arg2))) result) && - (FI.leq (FI.of_const (div Down (of_float Nearest arg1) (of_float Nearest arg2))) result)) + (FI.leq (FI.of_const (to_float (div Up (of_float Nearest arg1) (of_float Nearest arg2)))) result) && + (FI.leq (FI.of_const (to_float (div Down (of_float Nearest arg1) (of_float Nearest arg2)))) result)) let test () = [ From aed4cec86fb4c66c8b134ff9ea7a420327e49fb3 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Mon, 10 Jun 2024 14:00:18 +0200 Subject: [PATCH 084/107] added treatment of speculative computations in relational analyses --- src/cdomains/apron/sharedFunctions.apron.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 827dc252fc..e163ebf8ff 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -104,12 +104,13 @@ struct let texpr1_expr_of_cil_exp (ask:Queries.ask) d env exp no_ov = let conv exp = let query e ik = + if M.tracing then M.trace "relation-query" "before: texpr1_expr_of_cil_exp/query: %a" d_plainexp e; let res = match ask.f (EvalInt e) with | `Bot -> raise (Unsupported_CilExp Exp_not_supported) (* This should never happen according to Michael Schwarz *) | `Top -> IntDomain.IntDomTuple.top_of ik | `Lifted x -> x (* Cast should be unnecessary because it should be taken care of by EvalInt. *) in - if M.tracing then M.trace "relation" "texpr1_expr_of_cil_exp/query: %a -> %a" d_plainexp e IntDomain.IntDomTuple.pretty res; + if M.tracing then M.trace "relation-query" "texpr1_expr_of_cil_exp/query: %a -> %a" d_plainexp e IntDomain.IntDomTuple.pretty res; res in (* recurse without env and ask arguments *) @@ -138,10 +139,12 @@ struct this query is answered by the 2 var equalities domain itself. This normalizes arbitrary expressions to a point where they might be able to be represented by means of 2 var equalities *) let simplify e = + AnalysisState.executing_speculative_computations := true; let ikind = try (Cilfacade.get_ikind_exp e) with Invalid_argument _ -> raise (Unsupported_CilExp Exp_not_supported) in let simp = query e ikind in let const = IntDomain.IntDomTuple.to_int @@ IntDomain.IntDomTuple.cast_to ikind simp in if M.tracing then M.trace "relation" "texpr1_expr_of_cil_exp/simplify: %a -> %a" d_plainexp e IntDomain.IntDomTuple.pretty simp; + AnalysisState.executing_speculative_computations := false; BatOption.map_default (fun c -> Const (CInt (c, ikind, None))) e const in let texpr1 e = texpr1_expr_of_cil_exp (simplify e) in From 3df598090095223e6c4394bb271fa21e440861f8 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Tue, 11 Jun 2024 10:22:39 +0200 Subject: [PATCH 085/107] tweaks from MS' PR comments --- .../apron/linearTwoVarEqualityDomain.apron.ml | 61 +++++++++---------- src/cdomains/apron/sharedFunctions.apron.ml | 4 +- 2 files changed, 30 insertions(+), 35 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 923229ca96..069983344e 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -36,17 +36,17 @@ module Rhs = struct let rhs=show_rhs_formatted (Printf.sprintf "var_%d") (v,o,d) in if not (Z.equal d Z.one) then "(" ^ rhs ^ ")/" ^ (Z.to_string d) else rhs - (** factor out gcd from all terms, i.e. ax=by+c is the canonical form for adx+bdy+cd *) + (** factor out gcd from all terms, i.e. ax=by+c with a positive is the canonical form for adx+bdy+cd *) let canonicalize (v,o,d) = let gcd = Z.gcd o d in (* gcd of coefficients *) let gcd = Option.map_default (fun (c,_) -> Z.gcd c gcd) gcd v in (* include monomial in gcd computation *) - let commondivisor = if Z.(lt d zero) then Z.neg gcd else gcd in (* cannonical form dictates d being positive *) - (BatOption.map (fun (coeff,i) -> (Z.div coeff commondivisor,i)) v,Z.div o commondivisor, Z.div d commondivisor) + let commondivisor = if Z.(lt d zero) then Z.neg gcd else gcd in (* canonical form dictates d being positive *) + (BatOption.map (fun (coeff,i) -> (Z.div coeff commondivisor,i)) v, Z.div o commondivisor, Z.div d commondivisor) (** Substitute rhs for varx in rhs' *) let subst rhs varx rhs' = match rhs,rhs' with - | (monom,o,d),(Some (c',x'),o',d') when x'=varx -> canonicalize (Option.map (fun (c,x) -> (Z.mul c c',x)) monom,Z.((o*c')+(d*o')),Z.mul d d') + | (monom, o, d), (Some (c', x'), o', d') when x'=varx -> canonicalize (Option.map (fun (c,x) -> (Z.mul c c',x)) monom, Z.((o*c')+(d*o')), Z.mul d d') | _ -> rhs' end @@ -59,7 +59,7 @@ module EqualitiesConjunction = struct let show_formatted formatter econ = if IntMap.is_empty econ then "{}" else - let str = IntMap.fold (fun i (ref,off,divi) acc -> Printf.sprintf "%s%s=%s ∧ %s" (Rhs.show_coeff divi) (formatter i) (Rhs.show_rhs_formatted formatter (ref,off,divi)) acc) econ "" in + let str = IntMap.fold (fun i (refmonom,off,divi) acc -> Printf.sprintf "%s%s=%s ∧ %s" (Rhs.show_coeff divi) (formatter i) (Rhs.show_rhs_formatted formatter (refmonom,off,divi)) acc) econ "" in "{" ^ String.sub str 0 (String.length str - 4) ^ "}" let show econ = show_formatted (Printf.sprintf "var_%d") econ @@ -76,7 +76,7 @@ module EqualitiesConjunction = struct let nontrivial (_,econmap) lhs = IntMap.mem lhs econmap (** turn x = (cy+o)/d into y = (dx-o)/c*) - let inverse x (c,y,o,d) = (y,(Some (d,x),Z.neg o,c)) + let inverse x (c,y,o,d) = (y, (Some (d, x), Z.neg o, c)) (** sparse implementation of get rhs for lhs, but will default to no mapping for sparse entries *) let get_rhs (_,econmap) lhs = IntMap.find_default (Rhs.var_zero lhs) lhs econmap @@ -89,10 +89,9 @@ module EqualitiesConjunction = struct IntMap.add lhs rhs map ) - (** canonicalize equation, and set_rhs, staying loyal to immutable, sparse map underneath,*) + (** canonicalize equation, and set_rhs, staying loyal to immutable, sparse map underneath *) let canonicalize_and_set (dim,map) lhs rhs = set_rhs (dim,map) lhs (Rhs.canonicalize rhs) - (** add a new equality to the domain *) let copy = identity @@ -104,7 +103,7 @@ module EqualitiesConjunction = struct let offsetlist = Array.to_list indexes in let rec bumpvar delta i = function (* bump the variable i by delta; find delta by counting indices in offsetlist until we reach a larger index then our current parameter *) | head::rest when i>=head -> bumpvar (delta+1) i rest (* rec call even when =, in order to correctly interpret double bumps *) - | _ (* i let res = op i delta in res + | _ (* i op i delta in let memobumpvar = (* Memoized version of bumpvar *) let module IntHash = struct type t = int [@@deriving eq,hash] end in @@ -117,7 +116,8 @@ module EqualitiesConjunction = struct IntHashtbl.add h x r; r) in - let rec bumpentry k (refvar,offset,divi) = function (* directly bumps lhs-variable during a run through indexes, bumping refvar explicitely with a new lookup in indexes *) + let rec bumpentry k (refvar,offset,divi) = function (* directly bumps lhs-variable during a run through indexes, bumping refvar explicitly with a new lookup in indexes *) + | (tbl,delta,head::rest) when k>=head -> bumpentry k (refvar,offset,divi) (tbl,delta+1,rest) (* rec call even when =, in order to correctly interpret double bumps *) | (tbl,delta,lyst) (* k (IntMap.add (op k delta) (BatOption.map (fun (c,v) -> (c,memobumpvar v)) refvar,offset,divi) tbl, delta, lyst) in @@ -148,7 +148,7 @@ module EqualitiesConjunction = struct if M.tracing then M.trace "forget" "headvar var_%d" var; (* var is the reference variable of its connected component *) (let cluster = List.sort (Int.compare) @@ IntMap.fold - (fun i (ref,_,_) l -> BatOption.map_default (fun (coeff,ref) -> if (ref=ref_var) then i::l else l) l ref) (snd d) [] in + (fun i (refe,_,_) l -> BatOption.map_default (fun (coeff,refe) -> if (refe=ref_var) then i::l else l) l refe) (snd d) [] in if M.tracing then M.trace "forget" "cluster varindices: [%s]" (String.concat ", " (List.map (string_of_int) cluster)); (* obtain cluster with common reference variable ref_var*) match cluster with (* new ref_var is taken from head of the cluster *) @@ -157,7 +157,7 @@ module EqualitiesConjunction = struct (* divi*x = coeff*y + offs =inverse=> y =( divi*x - offs)/coeff *) let (newref,offs,divi) = (get_rhs d head) in let (coeff,y) = BatOption.get newref in - let (y,yrhs)= inverse head (coeff,y,offs,divi) in (* reassemble yrhs out of components *) + let (y,yrhs) = inverse head (coeff,y,offs,divi) in (* reassemble yrhs out of components *) let shifted_cluster = (List.fold (fun map i -> let irhs = (get_rhs d i) in (* old entry is i = irhs *) Rhs.subst yrhs y irhs |> (* new entry for i is irhs [yrhs/y] *) @@ -198,14 +198,15 @@ module EqualitiesConjunction = struct let meet_with_one_conj ts i (var, offs, divi) = let (var,offs,divi) = Rhs.canonicalize (var,offs,divi) in (* make sure that the one new conj is properly canonicalized *) let res = - let subst_var tsi x (vary, o, d) = + let subst_var (dim,econj) x (vary, o, d) = (* [[x substby (cy+o)/d ]] ((c'x+o')/d') *) (* =====> (c'cy + c'o+o'd)/(dd') *) let adjust = function - | (Some (c',varx), o',d') when varx = x -> Rhs.canonicalize (BatOption.map (fun (c,y)->(Z.mul c c',y)) vary, Z.((c'*o)+(o'*d)),Z.(d'*d)) + | (Some (c',varx), o',d') when varx = x -> + let open Z in Rhs.canonicalize (BatOption.map (fun (c, y)-> (c * c', y)) vary, c'*o + o'*d, d'*d) | e -> e in - (fst tsi, IntMap.add x (vary, o, d) @@ IntMap.map adjust (snd tsi)) (* in case of sparse representation, make sure that the equality is now included in the conjunction *) + (dim, IntMap.add x (vary, o, d) @@ IntMap.map adjust econj) (* in case of sparse representation, make sure that the equality is now included in the conjunction *) in (match var, (get_rhs ts i) with (*| new conj , old conj *) @@ -230,8 +231,8 @@ module EqualitiesConjunction = struct | (Some (coeff2,h2), o2, divi2) as normalizedj -> if h1 = h2 then (* this is the case where x_i and x_j already where in the same equivalence class; let's see whether the new equality contradicts the old one *) let normalizedi= Rhs.subst normalizedj j (Some(coeff,j),offs,divi) in - (if not @@ Rhs.equal normalizedi oldi then raise Contradiction else ts) - else if h1 < h2 (* good, we no unite the two equvalence classes; let's decide upon the representant *) + if not @@ Rhs.equal normalizedi oldi then raise Contradiction else ts + else if h1 < h2 (* good, we now unite the two equvalence classes; let's decide upon the representative *) then (* express h2 in terms of h1: *) let (_,newh2)= inverse j (coeff2,h2,o2,divi2) in let newh2 = Rhs.subst oldi i (Rhs.subst (snd @@ inverse i (coeff,j,offs,divi)) j newh2) in @@ -244,13 +245,10 @@ module EqualitiesConjunction = struct ; res (** affine transform variable i allover conj with transformer (Some (coeff,i)+offs)/divi *) - let affine_transform econ i (var,offs,divi) = - if nontrivial econ i then (** i cannot occur on any other rhs apart from itself *) - set_rhs econ i (Rhs.subst (get_rhs econ i) i (var,offs,divi)) + let affine_transform econ i (coeff, j, offs, divi) = + if nontrivial econ i then (* i cannot occur on any other rhs apart from itself *) + set_rhs econ i (Rhs.subst (get_rhs econ i) i (Some (coeff,j), offs, divi)) else (* var_i = var_i, i.e. it may occur on the rhs of other equalities *) - match var with - | None -> failwith "this is not a valid affine transformation" - | Some (coeff,j) -> (* so now, we transform with the inverse of the transformer: *) let inv = snd (inverse i (coeff,j,offs,divi)) in IntMap.fold (fun k v acc -> @@ -276,12 +274,10 @@ struct let open Apron.Texpr1 in let exception NotLinearExpr in let exception ScalarIsInfinity in - let negate coeff_var_list = List.map (function - | (Some(coeff,i),offs,divi) -> (Some(Z.neg coeff,i),Z.neg offs,divi) - | (None ,offs,divi) -> (None ,Z.neg offs,divi)) coeff_var_list in - let multiply_with_Q dividend divisor coeff_var_list = List.map (function - | (Some (coeff, var),offs,divi) -> Rhs.canonicalize (Some(Z.mul dividend coeff,var),Z.(dividend * offs),Z.mul divi divisor) - | (None,offs,divi) -> Rhs.canonicalize (None,Z.mul dividend offs,Z.mul divi divisor)) coeff_var_list in + let negate coeff_var_list = + List.map (fun (monom, offs, divi) -> Z.(BatOption.map (fun (coeff,i) -> (neg coeff, i)) monom, neg offs, divi)) coeff_var_list in + let multiply_with_Q dividend divisor coeff_var_list = + List.map (fun (monom, offs, divi) -> Rhs.canonicalize Z.(BatOption.map (fun (coeff,i) -> (dividend*coeff,i)) monom, dividend*offs, divi*divisor) ) coeff_var_list in let multiply a b = (* if one of them is a constant, then multiply. Otherwise, the expression is not linear *) match a, b with @@ -614,7 +610,7 @@ struct assign_const (forget_var t var) var_i off divi | Some (Some (coeff_var,exp_var), off, divi) when var_i = exp_var -> (* Statement "assigned_var = (coeff_var*assigned_var + off) / divi" *) - {d=Some (EConj.affine_transform d var_i (Some (coeff_var, var_i), off, divi)); env=t.env } + {d=Some (EConj.affine_transform d var_i (coeff_var, var_i, off, divi)); env=t.env } | Some (Some monomial, off, divi) -> (* Statement "assigned_var = (monomial) + off / divi" (assigned_var is not the same as exp_var) *) meet_with_one_conj (forget_var t var) var_i (Some (monomial), off, divi) @@ -742,10 +738,11 @@ struct | EQ -> (* c1*var1/d1 + c2*var2/d2 +constant/divisor = 0*) (* ======> c1*divisor*d2 * var1 = -c2*divisor*d1 * var2 +constant*-d1*d2*) (* \/ c2*divisor*d1 * var2 = -c1*divisor*d2 * var1 +constant*-d1*d2*) + let open Z in if var1 < var2 then - meet_with_one_conj t var2 (Rhs.canonicalize (Some (Z.neg @@ Z.(c1*divisor),var1),Z.neg @@ Z.(constant*d2*d1),Z.(c2*divisor*d1))) + meet_with_one_conj t var2 (Rhs.canonicalize (Some (neg @@ c1*divisor,var1),neg @@ constant*d2*d1,c2*divisor*d1)) else - meet_with_one_conj t var1 (Rhs.canonicalize (Some (Z.neg @@ Z.(c2*divisor),var2),Z.neg @@ Z.(constant*d2*d1),Z.(c1*divisor*d2))) + meet_with_one_conj t var1 (Rhs.canonicalize (Some (neg @@ c2*divisor,var2),neg @@ constant*d2*d1,c1*divisor*d2)) | _-> t (* Not supported in equality based 2vars without coeffiients *) end | _ -> t (* For equalities of more then 2 vars we just return t *)) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index e163ebf8ff..6b1993d381 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -104,7 +104,6 @@ struct let texpr1_expr_of_cil_exp (ask:Queries.ask) d env exp no_ov = let conv exp = let query e ik = - if M.tracing then M.trace "relation-query" "before: texpr1_expr_of_cil_exp/query: %a" d_plainexp e; let res = match ask.f (EvalInt e) with | `Bot -> raise (Unsupported_CilExp Exp_not_supported) (* This should never happen according to Michael Schwarz *) @@ -139,12 +138,11 @@ struct this query is answered by the 2 var equalities domain itself. This normalizes arbitrary expressions to a point where they might be able to be represented by means of 2 var equalities *) let simplify e = - AnalysisState.executing_speculative_computations := true; + GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> let ikind = try (Cilfacade.get_ikind_exp e) with Invalid_argument _ -> raise (Unsupported_CilExp Exp_not_supported) in let simp = query e ikind in let const = IntDomain.IntDomTuple.to_int @@ IntDomain.IntDomTuple.cast_to ikind simp in if M.tracing then M.trace "relation" "texpr1_expr_of_cil_exp/simplify: %a -> %a" d_plainexp e IntDomain.IntDomTuple.pretty simp; - AnalysisState.executing_speculative_computations := false; BatOption.map_default (fun c -> Const (CInt (c, ikind, None))) e const in let texpr1 e = texpr1_expr_of_cil_exp (simplify e) in From ca31b6e0eb0b7be74c359fd127e1267274836fef Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Tue, 11 Jun 2024 10:27:29 +0200 Subject: [PATCH 086/107] added explanation --- src/cdomains/apron/sharedFunctions.apron.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 6b1993d381..8c94c996b0 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -136,7 +136,13 @@ struct let expr = (** simplify asks for a constant value of some subexpression e, similar to a constant fold. In particular but not exclusively this query is answered by the 2 var equalities domain itself. This normalizes arbitrary expressions to a point where they - might be able to be represented by means of 2 var equalities *) + might be able to be represented by means of 2 var equalities + + This simplification happens during a time, when there are temporary variables a#in and a#out part of the expression, + but are not represented in the ctx, thus queries may result in top for these variables. Wrapping this in speculative + mode is a stop-gap measure to avoid flagging overflows. We however should address simplification in a more generally useful way. + outside of the apron-related expression conversion. + *) let simplify e = GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> let ikind = try (Cilfacade.get_ikind_exp e) with Invalid_argument _ -> raise (Unsupported_CilExp Exp_not_supported) in From 87e1e33843caaddaee111560287585b2bb1e28f8 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Tue, 11 Jun 2024 12:26:38 +0300 Subject: [PATCH 087/107] Use GobOption.forall instead Option.fold --- src/cdomain/value/cdomains/intDomain.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 69125a0d7a..7b3a8f955e 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -2256,7 +2256,7 @@ struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in + let is_negative = GobOption.for_all (fun x -> Z.compare x Z.zero < 0) in if is_negative (minimal x) || is_negative (minimal y) then top_of ik else @@ -2617,7 +2617,7 @@ module Enums : S with type int_t = Z.t = struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = Option.fold ~none:true ~some:(fun x -> Z.compare x Z.zero < 0) in + let is_negative = GobOption.for_all (fun x -> Z.compare x Z.zero < 0) in if is_negative (minimal x) || is_negative (minimal y) then top_of ik else From ae12610b61efeae7c91d9ccdfb50a0d342dc43d1 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Tue, 11 Jun 2024 12:27:10 +0300 Subject: [PATCH 088/107] Use Z.lt instead Z.compare --- src/cdomain/value/cdomains/intDomain.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 7b3a8f955e..d75c12527b 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -2256,7 +2256,7 @@ struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.compare x Z.zero < 0) in + let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in if is_negative (minimal x) || is_negative (minimal y) then top_of ik else @@ -2617,7 +2617,7 @@ module Enums : S with type int_t = Z.t = struct shift_op a b in (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.compare x Z.zero < 0) in + let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in if is_negative (minimal x) || is_negative (minimal y) then top_of ik else From f0c2c45c4003d222d8f86e6ee703f79f8a15b256 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Tue, 11 Jun 2024 13:15:36 +0200 Subject: [PATCH 089/107] simplify threshold search for narrowing --- src/cdomain/value/cdomains/intDomain.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index a67740e9db..efbab22b43 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -575,11 +575,11 @@ module IntervalArith (Ints_t : IntOps.IntOps) = struct let is_upper_threshold u = let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in let u = Ints_t.to_bigint u in - List.exists (fun x -> Z.compare u x = 0) ts + List.exists (Z.equal u) ts let is_lower_threshold l = let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in let l = Ints_t.to_bigint l in - List.exists (fun x -> Z.compare l x = 0) ts + List.exists (Z.equal l) ts end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = From 60ecfe7eb23fcdd927eed52da45c9da755dc7fa3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 12 Jun 2024 10:03:42 +0300 Subject: [PATCH 090/107] Fix LinearTwoVarEqualityDomain indentation (PR #1466) --- .../apron/linearTwoVarEqualityDomain.apron.ml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 069983344e..5558bc2c96 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -249,13 +249,13 @@ module EqualitiesConjunction = struct if nontrivial econ i then (* i cannot occur on any other rhs apart from itself *) set_rhs econ i (Rhs.subst (get_rhs econ i) i (Some (coeff,j), offs, divi)) else (* var_i = var_i, i.e. it may occur on the rhs of other equalities *) - (* so now, we transform with the inverse of the transformer: *) - let inv = snd (inverse i (coeff,j,offs,divi)) in - IntMap.fold (fun k v acc -> - match v with - | (Some (c,x),o,d) when x=i-> set_rhs acc k (Rhs.subst inv i v) - | _ -> acc - ) (snd econ) econ + (* so now, we transform with the inverse of the transformer: *) + let inv = snd (inverse i (coeff,j,offs,divi)) in + IntMap.fold (fun k v acc -> + match v with + | (Some (c,x),o,d) when x=i-> set_rhs acc k (Rhs.subst inv i v) + | _ -> acc + ) (snd econ) econ end From 19164253deacf3d6140fd4e917c7bc5b58be395d Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 12 Jun 2024 11:46:33 +0200 Subject: [PATCH 091/107] Introduce sync reason "SyncJoin" Helps avoid "sync" calls for function start nodes when threadflag is context-sensitive. Previsouly, it was only avoided when the flag was path-sensitive --- src/analyses/apron/relationAnalysis.apron.ml | 2 +- src/analyses/apron/relationPriv.apron.ml | 80 +++++++++++++------- src/analyses/base.ml | 2 +- src/analyses/basePriv.ml | 43 +++++++++-- src/analyses/basePriv.mli | 2 +- src/analyses/commonPriv.ml | 15 ++++ src/framework/analyses.ml | 2 +- src/framework/constraints.ml | 5 +- tests/regression/46-apron2/89-sides-pp.c | 27 +++++++ 9 files changed, 136 insertions(+), 42 deletions(-) create mode 100644 tests/regression/46-apron2/89-sides-pp.c diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 72b91d71b7..a42d78d71a 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -772,7 +772,7 @@ struct PCU.RH.replace results ctx.node new_value; end; WideningTokens.with_local_side_tokens (fun () -> - Priv.sync (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg ctx.local (reason :> [`Normal | `Join | `Return | `Init | `Thread]) + Priv.sync (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg ctx.local (reason :> [`Normal | `Join | `JoinCall | `Return | `Init | `Thread]) ) let init marshal = diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 61da6ddc42..6f75ddbfe5 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -36,7 +36,7 @@ module type S = val lock: Q.ask -> (V.t -> G.t) -> relation_components_t -> LockDomain.Addr.t -> relation_components_t val unlock: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> LockDomain.Addr.t -> relation_components_t - val sync: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> [`Normal | `Join | `Return | `Init | `Thread] -> relation_components_t + val sync: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> [`Normal | `Join | `JoinCall | `Return | `Init | `Thread] -> relation_components_t val escape: Node.t -> Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> EscapeDomain.EscapedVars.t -> relation_components_t val enter_multithreaded: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> relation_components_t @@ -96,8 +96,7 @@ struct { st with rel = rel_local } let sync (ask: Q.ask) getg sideg (st: relation_components_t) reason = - match reason with - | `Join when ConfCheck.branched_thread_creation () -> + let branched_sync () = if ask.f (Q.MustBeSingleThreaded {since_start = true}) then st else @@ -110,7 +109,14 @@ struct ) in {st with rel = rel_local} + in + match reason with + | `Join when ConfCheck.branched_thread_creation () -> + branched_sync () + | `JoinCall when ConfCheck.branched_thread_creation () -> + branched_sync () | `Join + | `JoinCall | `Normal | `Init | `Thread @@ -337,17 +343,8 @@ struct let thread_join ?(force=false) ask getg exp st = st let thread_return ask getg sideg tid st = st - let sync ask getg sideg (st: relation_components_t) reason = - match reason with - | `Return -> (* required for thread return *) - (* TODO: implement? *) - begin match ThreadId.get_current ask with - | `Lifted x (* when CPA.mem x st.cpa *) -> - st - | _ -> - st - end - | `Join when ConfCheck.branched_thread_creation () -> + let sync (ask:Q.ask) getg sideg (st: relation_components_t) reason = + let branched_sync () = if ask.f (Q.MustBeSingleThreaded { since_start= true }) then st else @@ -376,7 +373,22 @@ struct let rel_local' = RD.meet rel_local (getg ()) in {st with rel = rel_local'} *) st + in + match reason with + | `Return -> (* required for thread return *) + (* TODO: implement? *) + begin match ThreadId.get_current ask with + | `Lifted x (* when CPA.mem x st.cpa *) -> + st + | _ -> + st + end + | `Join when ConfCheck.branched_thread_creation () -> + branched_sync () + | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + branched_sync () | `Join + | `JoinCall | `Normal | `Init | `Thread -> @@ -626,17 +638,8 @@ struct let thread_join ?(force=false) ask getg exp st = st let thread_return ask getg sideg tid st = st - let sync ask getg sideg (st: relation_components_t) reason = - match reason with - | `Return -> (* required for thread return *) - (* TODO: implement? *) - begin match ThreadId.get_current ask with - | `Lifted x (* when CPA.mem x st.cpa *) -> - st - | _ -> - st - end - | `Join when ConfCheck.branched_thread_creation () -> + let sync (ask:Q.ask) getg sideg (st: relation_components_t) reason = + let branched_sync () = if ask.f (Q.MustBeSingleThreaded {since_start = true}) then st else @@ -659,7 +662,22 @@ struct ) in {st with rel = rel_local} + in + match reason with + | `Return -> (* required for thread return *) + (* TODO: implement? *) + begin match ThreadId.get_current ask with + | `Lifted x (* when CPA.mem x st.cpa *) -> + st + | _ -> + st + end + | `Join when ConfCheck.branched_thread_creation () -> + branched_sync () + | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + branched_sync () | `Join + | `JoinCall | `Normal | `Init | `Thread -> @@ -1192,9 +1210,7 @@ struct st let sync (ask:Q.ask) getg sideg (st: relation_components_t) reason = - match reason with - | `Return -> st (* TODO: implement? *) - | `Join when ConfCheck.branched_thread_creation () -> + let branched_sync () = if ask.f (Q.MustBeSingleThreaded {since_start = true}) then st else @@ -1209,7 +1225,15 @@ struct ) in {st with rel = rel_local} + in + match reason with + | `Return -> st (* TODO: implement? *) + | `Join when ConfCheck.branched_thread_creation () -> + branched_sync () + | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + branched_sync () | `Join + | `JoinCall | `Normal | `Init | `Thread -> diff --git a/src/analyses/base.ml b/src/analyses/base.ml index b80ac59d7f..102e22b5a7 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -451,7 +451,7 @@ struct else ctx.local - let sync ctx reason = sync' (reason :> [`Normal | `Join | `Return | `Init | `Thread]) ctx + let sync ctx reason = sync' (reason :> [`Normal | `Join | `JoinCall | `Return | `Init | `Thread]) ctx let publish_all ctx reason = ignore (sync' reason ctx) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index cecc838b9e..878a86d85e 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -31,7 +31,7 @@ sig val lock: Q.ask -> (V.t -> G.t) -> BaseComponents (D).t -> LockDomain.Addr.t -> BaseComponents (D).t val unlock: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> LockDomain.Addr.t -> BaseComponents (D).t - val sync: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> [`Normal | `Join | `Return | `Init | `Thread] -> BaseComponents (D).t + val sync: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> [`Normal | `Join | `JoinCall | `Return | `Init | `Thread] -> BaseComponents (D).t val escape: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> EscapeDomain.EscapedVars.t -> BaseComponents (D).t val enter_multithreaded: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> BaseComponents (D).t @@ -306,8 +306,8 @@ struct st let sync ask getg sideg (st: BaseComponents (D).t) reason = - match reason with - | `Join when ConfCheck.branched_thread_creation () -> (* required for branched thread creation *) + let branched_sync () = + (* required for branched thread creation *) let global_cpa = CPA.filter (fun x _ -> is_global ask x && is_unprotected ask x) st.cpa in sideg V.mutex_inits global_cpa; (* must be like enter_multithreaded *) (* TODO: this makes mutex-oplus less precise in 28-race_reach/10-ptrmunge_racefree and 28-race_reach/trylock2_racefree, why? *) @@ -318,7 +318,14 @@ struct sideg (V.global x) (CPA.singleton x v) ) st.cpa; st + in + match reason with + | `Join when ConfCheck.branched_thread_creation () -> + branched_sync () + | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + branched_sync () | `Join + | `JoinCall | `Return | `Normal | `Init @@ -404,8 +411,8 @@ struct {st with cpa = cpa'} let sync ask getg sideg (st: BaseComponents (D).t) reason = - match reason with - | `Join when ConfCheck.branched_thread_creation () -> (* required for branched thread creation *) + let branched_sync () = + (* required for branched thread creation *) let global_cpa = CPA.filter (fun x _ -> is_global ask x && is_unprotected ask x) st.cpa in sideg V.mutex_inits global_cpa; (* must be like enter_multithreaded *) @@ -422,7 +429,14 @@ struct ) st.cpa st.cpa in {st with cpa = cpa'} + in + match reason with + | `Join when ConfCheck.branched_thread_creation () -> + branched_sync () + | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + branched_sync () | `Join + | `JoinCall | `Return | `Normal | `Init @@ -772,9 +786,9 @@ struct ) st.cpa st let sync ask getg sideg (st: BaseComponents (D).t) reason = - let sideg = Wrapper.sideg ask sideg in - match reason with - | `Join when ConfCheck.branched_thread_creation () -> (* required for branched thread creation *) + let branched_sync () = + (* required for branched thread creation *) + let sideg = Wrapper.sideg ask sideg in CPA.fold (fun x v (st: BaseComponents (D).t) -> if is_global ask x && is_unprotected ask x then ( sideg (V.unprotected x) v; @@ -784,7 +798,14 @@ struct else st ) st.cpa st + in + match reason with + | `Join when ConfCheck.branched_thread_creation () -> + branched_sync () + | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + branched_sync () | `Join + | `JoinCall | `Return | `Normal | `Init @@ -1034,6 +1055,7 @@ struct | `Return | `Normal | `Join (* TODO: no problem with branched thread creation here? *) + | `JoinCall | `Init | `Thread -> st @@ -1089,6 +1111,7 @@ struct | `Return | `Normal | `Join (* TODO: no problem with branched thread creation here? *) + | `JoinCall | `Init | `Thread -> st @@ -1160,6 +1183,7 @@ struct | `Return | `Normal | `Join (* TODO: no problem with branched thread creation here? *) + | `JoinCall | `Init | `Thread -> st @@ -1318,6 +1342,7 @@ struct | `Return | `Normal | `Join (* TODO: no problem with branched thread creation here? *) + | `JoinCall | `Init | `Thread -> st @@ -1496,6 +1521,7 @@ struct | `Return | `Normal | `Join (* TODO: no problem with branched thread creation here? *) + | `JoinCall | `Init | `Thread -> st @@ -1678,6 +1704,7 @@ struct | `Return | `Normal | `Join (* TODO: no problem with branched thread creation here? *) + | `JoinCall | `Init | `Thread -> st diff --git a/src/analyses/basePriv.mli b/src/analyses/basePriv.mli index e176a450fa..87b17e5ad0 100644 --- a/src/analyses/basePriv.mli +++ b/src/analyses/basePriv.mli @@ -20,7 +20,7 @@ sig val lock: Queries.ask -> (V.t -> G.t) -> BaseDomain.BaseComponents (D).t -> LockDomain.Addr.t -> BaseDomain.BaseComponents (D).t val unlock: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> LockDomain.Addr.t -> BaseDomain.BaseComponents (D).t - val sync: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> [`Normal | `Join | `Return | `Init | `Thread] -> BaseDomain.BaseComponents (D).t + val sync: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> [`Normal | `Join | `JoinCall | `Return | `Init | `Thread] -> BaseDomain.BaseComponents (D).t val escape: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> EscapeDomain.EscapedVars.t -> BaseDomain.BaseComponents (D).t val enter_multithreaded: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index fb5d0db142..9f87f35b38 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -59,6 +59,21 @@ struct not threadflag_path_sens else true + + (** Whether branched thread creation at start nodes of procedures needs to be handled by [sync `JoinCall] of privatization. *) + let branched_thread_creation_at_call () = + let threadflag_active = List.mem "threadflag" (GobConfig.get_string_list "ana.activated") in + if threadflag_active then + let sens = GobConfig.get_string_list "ana.ctx_sens" in + let threadflag_ctx_sens = match sens with + | [] -> (* use values of "ana.ctx_insens" (blacklist) *) + not (List.mem "threadflag" @@ GobConfig.get_string_list "ana.ctx_insens") + | sens -> (* use values of "ana.ctx_sens" (whitelist) *) + List.mem "threadflag" sens + in + not threadflag_ctx_sens + else + true end module Protection = diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 4ef98358f4..1ea01c99fb 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -209,7 +209,7 @@ sig val context: (D.t, G.t, C.t, V.t) ctx -> fundec -> D.t -> C.t val startcontext: unit -> C.t - val sync : (D.t, G.t, C.t, V.t) ctx -> [`Normal | `Join | `Return] -> D.t + val sync : (D.t, G.t, C.t, V.t) ctx -> [`Normal | `Join | `JoinCall | `Return] -> D.t val query : (D.t, G.t, C.t, V.t) ctx -> 'a Queries.t -> 'a Queries.result (** A transfer function which handles the assignment of a rval to a lval, i.e., diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index 07180d54dd..6a1eae3ed1 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -624,9 +624,10 @@ struct let sync ctx = match ctx.prev_node, Cfg.prev ctx.prev_node with - | _, _ :: _ :: _ (* Join in CFG. *) - | FunctionEntry _, _ -> (* Function entry, also needs sync because partial contexts joined by solver, see 00-sanity/35-join-contexts. *) + | _, _ :: _ :: _ -> (* Join in CFG. *) S.sync ctx `Join + | FunctionEntry _, _ -> (* Function entry, also needs sync because partial contexts joined by solver, see 00-sanity/35-join-contexts. *) + S.sync ctx `JoinCall | _, _ -> S.sync ctx `Normal let side_context sideg f c = diff --git a/tests/regression/46-apron2/89-sides-pp.c b/tests/regression/46-apron2/89-sides-pp.c new file mode 100644 index 0000000000..10fc5f8d1e --- /dev/null +++ b/tests/regression/46-apron2/89-sides-pp.c @@ -0,0 +1,27 @@ +// SKIP PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet +// NOTIMEOUT +#include +#include + +int g; +pthread_mutex_t m = PTHREAD_MUTEX_INITIALIZER; + +void fn() { + // Just do nothing + return; +} + +void *t_fun(void *arg) { + pthread_mutex_lock(&m); + g = g+1; + fn(); + pthread_mutex_unlock(&m); + return NULL; +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + return 0; +} From 496b5ef26373e4e7b06832657f0ba196db671806 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 12 Jun 2024 18:05:34 +0200 Subject: [PATCH 092/107] Add misbehaving program with gas --- src/config/options.schema.json | 2 +- tests/regression/80-context_gas/21-sync.c | 35 +++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 tests/regression/80-context_gas/21-sync.c diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 488fc494b0..acf85abed9 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -980,7 +980,7 @@ }, "gas_value": { "title": "ana.context.gas_value", - "description": "Denotes the gas value x for the ContextGasLifter. Negative values deactivate the context gas, zero yields a context-insensitve analysis. If enabled, the first x recursive calls of the call stack are analyzed context-sensitively. Any calls deeper in the call stack are analyzed with the same (empty) context.", + "description": "Denotes the gas value x for the ContextGasLifter. Negative values deactivate the context gas, zero yields a context-insensitive analysis. If enabled, the first x recursive calls of the call stack are analyzed context-sensitively. Any calls deeper in the call stack are analyzed with the same (empty) context.", "type": "integer", "default": -1 }, diff --git a/tests/regression/80-context_gas/21-sync.c b/tests/regression/80-context_gas/21-sync.c new file mode 100644 index 0000000000..5769ffaa67 --- /dev/null +++ b/tests/regression/80-context_gas/21-sync.c @@ -0,0 +1,35 @@ +// PARAM: --set ana.context.gas_value 3 +// Like 00/35 but with gas this time! +// Misbehaves for gas <= 3 +#include +#include + +int g = 1; + +void foo() { + // Single-threaded: g = 1 in local state + // Multi-threaded: g = 2 in global unprotected invariant + // Joined contexts: g is unprotected, so read g = 2 from global unprotected invariant (only) + // Was soundly claiming that check will succeed! + int x = g; + __goblint_check(x == 2); // UNKNOWN! +} + +void *t_fun(void *arg) { + foo(); +} + +int do_stuff() { + foo(); + g = 2; + + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + return 0; +} + +int main() { + do_stuff(); + return 0; +} From e613e13d64ede078c23b85401a8176107f81d567 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 12 Jun 2024 18:53:17 +0200 Subject: [PATCH 093/107] Make sound for context gas --- src/analyses/apron/relationPriv.apron.ml | 6 ++-- src/analyses/basePriv.ml | 6 ++-- src/analyses/commonPriv.ml | 7 ++-- src/analyses/mCP.ml | 7 ++++ src/domains/queries.ml | 5 +++ src/framework/constraints.ml | 8 ++++- tests/regression/80-context_gas/21-sync.c | 2 +- .../80-context_gas/22-sync-precision.c | 36 +++++++++++++++++++ 8 files changed, 67 insertions(+), 10 deletions(-) create mode 100644 tests/regression/80-context_gas/22-sync-precision.c diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 6f75ddbfe5..3ecfb713d7 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -385,7 +385,7 @@ struct end | `Join when ConfCheck.branched_thread_creation () -> branched_sync () - | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + | `JoinCall when ConfCheck.branched_thread_creation_at_call ask -> branched_sync () | `Join | `JoinCall @@ -674,7 +674,7 @@ struct end | `Join when ConfCheck.branched_thread_creation () -> branched_sync () - | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + | `JoinCall when ConfCheck.branched_thread_creation_at_call ask -> branched_sync () | `Join | `JoinCall @@ -1230,7 +1230,7 @@ struct | `Return -> st (* TODO: implement? *) | `Join when ConfCheck.branched_thread_creation () -> branched_sync () - | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + | `JoinCall when ConfCheck.branched_thread_creation_at_call ask -> branched_sync () | `Join | `JoinCall diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 878a86d85e..efa0575bf4 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -322,7 +322,7 @@ struct match reason with | `Join when ConfCheck.branched_thread_creation () -> branched_sync () - | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + | `JoinCall when ConfCheck.branched_thread_creation_at_call ask -> branched_sync () | `Join | `JoinCall @@ -433,7 +433,7 @@ struct match reason with | `Join when ConfCheck.branched_thread_creation () -> branched_sync () - | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + | `JoinCall when ConfCheck.branched_thread_creation_at_call ask -> branched_sync () | `Join | `JoinCall @@ -802,7 +802,7 @@ struct match reason with | `Join when ConfCheck.branched_thread_creation () -> branched_sync () - | `JoinCall when ConfCheck.branched_thread_creation_at_call () -> + | `JoinCall when ConfCheck.branched_thread_creation_at_call ask -> branched_sync () | `Join | `JoinCall diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 9f87f35b38..1ece8dcc60 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -61,7 +61,7 @@ struct true (** Whether branched thread creation at start nodes of procedures needs to be handled by [sync `JoinCall] of privatization. *) - let branched_thread_creation_at_call () = + let branched_thread_creation_at_call (ask:Queries.ask) = let threadflag_active = List.mem "threadflag" (GobConfig.get_string_list "ana.activated") in if threadflag_active then let sens = GobConfig.get_string_list "ana.ctx_sens" in @@ -71,7 +71,10 @@ struct | sens -> (* use values of "ana.ctx_sens" (whitelist) *) List.mem "threadflag" sens in - not threadflag_ctx_sens + if not threadflag_ctx_sens then + true + else + ask.f (Queries.GasExhausted) else true end diff --git a/src/analyses/mCP.ml b/src/analyses/mCP.ml index 71c887dda5..e4c0e261e4 100644 --- a/src/analyses/mCP.ml +++ b/src/analyses/mCP.ml @@ -318,6 +318,13 @@ struct f (Result.top ()) (!base_id, spec !base_id, assoc !base_id ctx.local) *) | Queries.DYojson -> `Lifted (D.to_yojson ctx.local) + | Queries.GasExhausted -> + if (get_int "ana.context.gas_value" >= 0) then + (* There is a lifter above this that will answer it, save to ask *) + ctx.ask (Queries.GasExhausted) + else + (* Abort to avoid infinite recursion *) + false | _ -> let r = fold_left (f ~q) (Result.top ()) @@ spec_list ctx.local in do_sideg ctx !sides; diff --git a/src/domains/queries.ml b/src/domains/queries.ml index a904f696eb..1ceb91ef1d 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -126,6 +126,7 @@ type _ t = | IsEverMultiThreaded: MayBool.t t | TmpSpecial: Mval.Exp.t -> ML.t t | MaySignedOverflow: exp -> MayBool.t t + | GasExhausted: MustBool.t t type 'a result = 'a @@ -196,6 +197,7 @@ struct | IsEverMultiThreaded -> (module MayBool) | TmpSpecial _ -> (module ML) | MaySignedOverflow _ -> (module MayBool) + | GasExhausted -> (module MustBool) (** Get bottom result for query. *) let bot (type a) (q: a t): a result = @@ -265,6 +267,7 @@ struct | IsEverMultiThreaded -> MayBool.top () | TmpSpecial _ -> ML.top () | MaySignedOverflow _ -> MayBool.top () + | GasExhausted -> MustBool.top () end (* The type any_query can't be directly defined in Any as t, @@ -331,6 +334,7 @@ struct | Any (TmpSpecial _) -> 56 | Any (IsAllocVar _) -> 57 | Any (MaySignedOverflow _) -> 58 + | Any GasExhausted -> 59 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -490,6 +494,7 @@ struct | Any IsEverMultiThreaded -> Pretty.dprintf "IsEverMultiThreaded" | Any (TmpSpecial lv) -> Pretty.dprintf "TmpSpecial %a" Mval.Exp.pretty lv | Any (MaySignedOverflow e) -> Pretty.dprintf "MaySignedOverflow %a" CilType.Exp.pretty e + | Any GasExhausted -> Pretty.dprintf "GasExhausted" end let to_value_domain_ask (ask: ask) = diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index 6a1eae3ed1..e0e36801ed 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -575,8 +575,14 @@ struct let liftmap f = List.map (fun (x) -> (x, max 0 (cg_val ctx - 1))) f in liftmap (S.threadenter (conv ctx) ~multiple lval f args) + let query ctx (type a) (q: a Queries.t):a Queries.result = + match q with + | Queries.GasExhausted -> + let (d,i) = ctx.local in + (i <= 0) + | _ -> S.query (conv ctx) q + let sync ctx reason = S.sync (conv ctx) reason, cg_val ctx - let query ctx q = S.query (conv ctx) q let assign ctx lval expr = S.assign (conv ctx) lval expr, cg_val ctx let vdecl ctx v = S.vdecl (conv ctx) v, cg_val ctx let body ctx fundec = S.body (conv ctx) fundec, cg_val ctx diff --git a/tests/regression/80-context_gas/21-sync.c b/tests/regression/80-context_gas/21-sync.c index 5769ffaa67..33edf254e5 100644 --- a/tests/regression/80-context_gas/21-sync.c +++ b/tests/regression/80-context_gas/21-sync.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.context.gas_value 3 +// PARAM: --set ana.context.gas_value 1 // Like 00/35 but with gas this time! // Misbehaves for gas <= 3 #include diff --git a/tests/regression/80-context_gas/22-sync-precision.c b/tests/regression/80-context_gas/22-sync-precision.c new file mode 100644 index 0000000000..8fc1dd7779 --- /dev/null +++ b/tests/regression/80-context_gas/22-sync-precision.c @@ -0,0 +1,36 @@ +// PARAM: --set ana.context.gas_value 4 +// Like 00/35 but with gas this time! +// Misbehaves for gas <= 3 +#include +#include + +int g = 1; + +void foo() { + // Check that we don't lose precision due to JoinCall + int x = g; + int x2 = g; + // A hack: In both contexts g has a single possible value, so we check that x = x2 + // to verify there is no precision loss + + __goblint_check(x == x2); +} + +void *t_fun(void *arg) { + foo(); +} + +int do_stuff() { + foo(); + g = 2; + + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + return 0; +} + +int main() { + do_stuff(); + return 0; +} From eec5f2c747d6afae162501a0a94f28637f5d2f81 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 13 Jun 2024 14:49:28 +0200 Subject: [PATCH 094/107] Rename test and add reference --- tests/regression/46-apron2/{89-sides-pp.c => 89-flag-ctx-sens.c} | 1 + 1 file changed, 1 insertion(+) rename tests/regression/46-apron2/{89-sides-pp.c => 89-flag-ctx-sens.c} (89%) diff --git a/tests/regression/46-apron2/89-sides-pp.c b/tests/regression/46-apron2/89-flag-ctx-sens.c similarity index 89% rename from tests/regression/46-apron2/89-sides-pp.c rename to tests/regression/46-apron2/89-flag-ctx-sens.c index 10fc5f8d1e..41e4f02520 100644 --- a/tests/regression/46-apron2/89-sides-pp.c +++ b/tests/regression/46-apron2/89-flag-ctx-sens.c @@ -1,5 +1,6 @@ // SKIP PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet // NOTIMEOUT +// See https://github.com/goblint/analyzer/pull/1508 #include #include From 2fefea01a7816968035328557d060cd5f61f5407 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 17 Jun 2024 20:52:18 +0000 Subject: [PATCH 095/107] Bump docker/build-push-action from 5 to 6 Bumps [docker/build-push-action](https://github.com/docker/build-push-action) from 5 to 6. - [Release notes](https://github.com/docker/build-push-action/releases) - [Commits](https://github.com/docker/build-push-action/compare/v5...v6) --- updated-dependencies: - dependency-name: docker/build-push-action dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/docker.yml | 4 ++-- .github/workflows/unlocked.yml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/docker.yml b/.github/workflows/docker.yml index 36568e6cb2..daa7f224b8 100644 --- a/.github/workflows/docker.yml +++ b/.github/workflows/docker.yml @@ -59,7 +59,7 @@ jobs: - name: Build Docker image id: build - uses: docker/build-push-action@v5 + uses: docker/build-push-action@v6 with: context: . load: true # load into docker instead of immediately pushing @@ -72,7 +72,7 @@ jobs: run: docker run --rm -v $(pwd):/data ${{ env.REGISTRY }}/${{ env.IMAGE_NAME }}:${{ steps.meta.outputs.version }} /data/tests/regression/04-mutex/01-simple_rc.c # run image by version in case multiple tags - name: Push Docker image - uses: docker/build-push-action@v5 + uses: docker/build-push-action@v6 with: context: . push: true diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index db41ad3007..f1bd399a17 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -165,7 +165,7 @@ jobs: - name: Build dev Docker image id: build - uses: docker/build-push-action@v5 + uses: docker/build-push-action@v6 with: context: . target: dev From 4812b07e58b7c854e2fc4c25763101cb73800e69 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 18 Jun 2024 13:41:00 +0300 Subject: [PATCH 096/107] Avoid unused value warning on LibraryFunctions.all_library_descs --- src/util/library/libraryFunctions.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/util/library/libraryFunctions.ml b/src/util/library/libraryFunctions.ml index 4e678c926e..e7ff2a4d04 100644 --- a/src/util/library/libraryFunctions.ml +++ b/src/util/library/libraryFunctions.ml @@ -1246,7 +1246,7 @@ let libraries = descs_tbl ) libraries -let all_library_descs: (string, LibraryDesc.t) Hashtbl.t = +let _all_library_descs: (string, LibraryDesc.t) Hashtbl.t = Hashtbl.fold (fun _ descs_tbl acc -> Hashtbl.merge (fun name desc1 desc2 -> match desc1, desc2 with From 62f01a9778ccc61b3894a292a522ee397394ab5f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 18 Jun 2024 18:05:57 +0300 Subject: [PATCH 097/107] Add cram test for int witness invariants --- tests/regression/witness/int.t/int.c | 17 ++++++++++ tests/regression/witness/int.t/run.t | 47 ++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+) create mode 100644 tests/regression/witness/int.t/int.c create mode 100644 tests/regression/witness/int.t/run.t diff --git a/tests/regression/witness/int.t/int.c b/tests/regression/witness/int.t/int.c new file mode 100644 index 0000000000..4ad15b09ad --- /dev/null +++ b/tests/regression/witness/int.t/int.c @@ -0,0 +1,17 @@ +#include +extern int __VERIFIER_nondet_int(); + +int main() { + int i; + i = __VERIFIER_nondet_int(); + + if (i < 100) + __goblint_check(1); + + if (50 < i && i < 100) + __goblint_check(1); + + if (i == 42 || i == 5 || i == 101) + __goblint_check(1); + return 0; +} diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t new file mode 100644 index 0000000000..28c670d475 --- /dev/null +++ b/tests/regression/witness/int.t/run.t @@ -0,0 +1,47 @@ + $ goblint --enable ana.sv-comp.functions --enable witness.yaml.enabled --set witness.yaml.entry-types '["location_invariant"]' --enable ana.int.def_exc --enable ana.int.enums --enable ana.int.interval --enable ana.int.congruence --enable ana.int.interval_set --disable witness.invariant.split-conjunction int.c + [Success][Assert] Assertion "1" will succeed (int.c:9:5-9:23) + [Success][Assert] Assertion "1" will succeed (int.c:12:5-12:23) + [Success][Assert] Assertion "1" will succeed (int.c:15:5-15:23) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 10 + dead: 0 + total lines: 10 + [Info][Witness] witness generation summary: + total generation entries: 3 + + $ yamlWitnessStrip < witness.yml + - entry_type: location_invariant + location: + file_name: int.c + file_hash: $FILE_HASH + line: 15 + column: 5 + function: main + location_invariant: + string: ((((0 <= i && i <= 127) && i != 0) && (5 <= i && i <= 101)) && ((i == + 5 || i == 42) || i == 101)) && ((i == 5 || i == 42) || i == 101) + type: assertion + format: C + - entry_type: location_invariant + location: + file_name: int.c + file_hash: $FILE_HASH + line: 12 + column: 5 + function: main + location_invariant: + string: (((0 <= i && i != 0) && (51 <= i && i <= 99)) && (0 <= i && i != 0)) && + (51 <= i && i <= 99) + type: assertion + format: C + - entry_type: location_invariant + location: + file_name: int.c + file_hash: $FILE_HASH + line: 9 + column: 5 + function: main + location_invariant: + string: i <= 99 && i <= 99 + type: assertion + format: C From ca5f0646bc18d055d36501b9db5ca72d09854818 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:25:32 +0300 Subject: [PATCH 098/107] Extract inclusion list invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 30 ++++++++++++++++--------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index c525732d3b..89be71ea92 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -582,6 +582,24 @@ module IntervalArith (Ints_t : IntOps.IntOps) = struct List.exists (Z.equal l) ts end +module IntInvariant = +struct + let of_incl_list e ik ps = + match ps with + | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> + assert (List.mem Z.zero ps); + assert (List.mem Z.one ps); + Invariant.none + | [_] when get_bool "witness.invariant.exact" -> + Invariant.none + | _ :: _ :: _ + | [_] | [] -> + List.fold_left (fun a x -> + let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in + Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) (Invariant.bot ()) ps +end + module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = struct let name () = "intervals" @@ -2731,19 +2749,11 @@ module Enums : S with type int_t = Z.t = struct let ne ik x y = c_lognot ik (eq ik x y) let invariant_ikind e ik x = - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in match x with - | Inc ps when not inexact_type_bounds && ik = IBool && is_top_of ik x -> - Invariant.none | Inc ps -> - if BISet.cardinal ps > 1 || get_bool "witness.invariant.exact" then - BISet.fold (fun x a -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) ps (Invariant.bot ()) - else - Invariant.top () + IntInvariant.of_incl_list e ik (BISet.elements ps) | Exc (ns, r) -> + let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in From e767f90fdcce9eb4348341129915a515d2539d4e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:26:43 +0300 Subject: [PATCH 099/107] Simplify inclusion list invariants --- src/cdomain/value/cdomains/intDomain.ml | 12 ++++++---- .../56-witness/46-top-bool-invariant.t | 24 +------------------ tests/regression/witness/int.t/run.t | 3 +-- 3 files changed, 10 insertions(+), 29 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 89be71ea92..b9723bdb5b 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3797,10 +3797,14 @@ module IntDomTupleImpl = struct else Invariant.top () | None -> - let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) - in List.fold_left (fun a i -> - Invariant.(a && i) - ) (Invariant.top ()) is + match to_incl_list x with + | Some ps -> + IntInvariant.of_incl_list e ik ps + | None -> + let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) + in List.fold_left (fun a i -> + Invariant.(a && i) + ) (Invariant.top ()) is let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) diff --git a/tests/regression/56-witness/46-top-bool-invariant.t b/tests/regression/56-witness/46-top-bool-invariant.t index b04d33dda8..741b00966f 100644 --- a/tests/regression/56-witness/46-top-bool-invariant.t +++ b/tests/regression/56-witness/46-top-bool-invariant.t @@ -144,7 +144,7 @@ all: dead: 0 total lines: 2 [Info][Witness] witness generation summary: - total generation entries: 3 + total generation entries: 1 $ yamlWitnessStrip < witness.yml - entry_type: location_invariant @@ -158,28 +158,6 @@ all: string: x == (_Bool)0 || x == (_Bool)1 type: assertion format: C - - entry_type: location_invariant - location: - file_name: 46-top-bool-invariant.c - file_hash: $FILE_HASH - line: 5 - column: 3 - function: main - location_invariant: - string: x <= (_Bool)1 - type: assertion - format: C - - entry_type: location_invariant - location: - file_name: 46-top-bool-invariant.c - file_hash: $FILE_HASH - line: 5 - column: 3 - function: main - location_invariant: - string: (_Bool)0 <= x - type: assertion - format: C all without inexact-type-bounds: diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 28c670d475..6f75a2cd17 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -18,8 +18,7 @@ column: 5 function: main location_invariant: - string: ((((0 <= i && i <= 127) && i != 0) && (5 <= i && i <= 101)) && ((i == - 5 || i == 42) || i == 101)) && ((i == 5 || i == 42) || i == 101) + string: (i == 5 || i == 42) || i == 101 type: assertion format: C - entry_type: location_invariant From 176941d1a1582f45eec20ad5d3f9c1d648bffc7d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:34:09 +0300 Subject: [PATCH 100/107] Extract definite int invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 29 ++++++++++--------------- 1 file changed, 11 insertions(+), 18 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index b9723bdb5b..f0715c2e57 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -584,6 +584,12 @@ end module IntInvariant = struct + let of_int e ik x = + if get_bool "witness.invariant.exact" then + Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) + else + Invariant.none + let of_incl_list e ik ps = match ps with | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> @@ -936,11 +942,7 @@ struct let invariant_ikind e ik x = match x with | Some (x1, x2) when Ints_t.compare x1 x2 = 0 -> - if get_bool "witness.invariant.exact" then - let x1 = Ints_t.to_bigint x1 in - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x1, intType)) - else - Invariant.top () + IntInvariant.of_int e ik (Ints_t.to_bigint x1) | Some (x1, x2) -> let (min_ik, max_ik) = range ik in let (x1', x2') = BatTuple.Tuple2.mapn (Ints_t.to_bigint) (x1, x2) in @@ -2315,10 +2317,7 @@ struct let invariant_ikind e ik (x:t) = match x with | `Definite x -> - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.top () + IntInvariant.of_int e ik x | `Excluded (s, r) -> (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) @@ -3253,10 +3252,7 @@ struct match x with | x when is_top x -> Invariant.top () | Some (c, m) when m =: Z.zero -> - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, Cil.kintegerCilint ik c, intType)) - else - Invariant.top () + IntInvariant.of_int e ik c | Some (c, m) -> let open Cil in let (c, m) = BatTuple.Tuple2.mapn (fun a -> kintegerCilint ik a) (c, m) in @@ -3791,11 +3787,8 @@ module IntDomTupleImpl = struct let invariant_ikind e ik x = match to_int x with | Some v -> - if get_bool "witness.invariant.exact" then - (* If definite, output single equality instead of every subdomain repeating same equality *) - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik v, intType)) - else - Invariant.top () + (* If definite, output single equality instead of every subdomain repeating same equality *) + IntInvariant.of_int e ik v | None -> match to_incl_list x with | Some ps -> From 250196bfb9ee6f2cd2195cc9b46b1c275452a731 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:44:39 +0300 Subject: [PATCH 101/107] Extract interval invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 44 ++++++++++--------------- 1 file changed, 18 insertions(+), 26 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index f0715c2e57..bdd403bbce 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -604,6 +604,17 @@ struct let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) (Invariant.bot ()) ps + + let of_interval e ik (x1, x2) = + if Z.equal x1 x2 then + of_int e ik x1 + else ( + let (min_ik, max_ik) = Size.range ik in + let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in + let i1 = if inexact_type_bounds || Z.compare min_ik x1 <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) else Invariant.none in + let i2 = if inexact_type_bounds || Z.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) else Invariant.none in + Invariant.(i1 && i2) + ) end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = @@ -939,17 +950,10 @@ struct else if Ints_t.compare y2 x1 <= 0 then of_bool ik false else top_bool - let invariant_ikind e ik x = - match x with - | Some (x1, x2) when Ints_t.compare x1 x2 = 0 -> - IntInvariant.of_int e ik (Ints_t.to_bigint x1) + let invariant_ikind e ik = function | Some (x1, x2) -> - let (min_ik, max_ik) = range ik in - let (x1', x2') = BatTuple.Tuple2.mapn (Ints_t.to_bigint) (x1, x2) in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = if inexact_type_bounds || Ints_t.compare min_ik x1 <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1', e, intType)) else Invariant.none in - let i2 = if inexact_type_bounds || Ints_t.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2', intType)) else Invariant.none in - Invariant.(i1 && i2) + let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in + IntInvariant.of_interval e ik (x1', x2') | None -> Invariant.none let arbitrary ik = @@ -2322,17 +2326,11 @@ struct (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let (ikmin, ikmax) = - let ikr = size ik in - (Exclusion.min_of_range ikr, Exclusion.max_of_range ikr) - in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let imin = if inexact_type_bounds || Z.compare ikmin rmin <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik rmin, e, intType)) else Invariant.none in - let imax = if inexact_type_bounds || Z.compare rmax ikmax <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik rmax, intType)) else Invariant.none in + let ri = IntInvariant.of_interval e ik (rmin, rmax) in S.fold (fun x a -> let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in Invariant.(a && i) - ) s Invariant.(imin && imax) + ) s ri | `Bot -> Invariant.none let arbitrary ik = @@ -2752,20 +2750,14 @@ module Enums : S with type int_t = Z.t = struct | Inc ps -> IntInvariant.of_incl_list e ik (BISet.elements ps) | Exc (ns, r) -> - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let (ikmin, ikmax) = - let ikr = size ik in - (Exclusion.min_of_range ikr, Exclusion.max_of_range ikr) - in - let imin = if inexact_type_bounds || Z.compare ikmin rmin <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik rmin, e, intType)) else Invariant.none in - let imax = if inexact_type_bounds || Z.compare rmax ikmax <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik rmax, intType)) else Invariant.none in + let ri = IntInvariant.of_interval e ik (rmin, rmax) in BISet.fold (fun x a -> let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in Invariant.(a && i) - ) ns Invariant.(imin && imax) + ) ns ri let arbitrary ik = From 9a25b4859c45671b416281784e26f8e1781ca7b2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:49:15 +0300 Subject: [PATCH 102/107] Extract exclusion list invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index bdd403bbce..79c672f689 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -615,6 +615,12 @@ struct let i2 = if inexact_type_bounds || Z.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) else Invariant.none in Invariant.(i1 && i2) ) + + let of_excl_list e ik ns = + List.fold_left (fun a x -> + let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in + Invariant.(a && i) + ) (Invariant.top ()) ns end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = @@ -2327,10 +2333,8 @@ struct This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in let ri = IntInvariant.of_interval e ik (rmin, rmax) in - S.fold (fun x a -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) s ri + let si = IntInvariant.of_excl_list e ik (S.elements s) in + Invariant.(ri && si) | `Bot -> Invariant.none let arbitrary ik = @@ -2754,10 +2758,8 @@ module Enums : S with type int_t = Z.t = struct This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in let ri = IntInvariant.of_interval e ik (rmin, rmax) in - BISet.fold (fun x a -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) ns ri + let nsi = IntInvariant.of_excl_list e ik (BISet.elements ns) in + Invariant.(ri && nsi) let arbitrary ik = From d1f04bc23150d0b186d52f1ccaf170f54916bd8f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:35:20 +0300 Subject: [PATCH 103/107] Simplify interval and exclusion list invariants --- src/cdomain/value/cdomains/intDomain.ml | 39 ++++++++++++++++++------- tests/regression/cfg/foo.t/run.t | 24 +-------------- tests/regression/witness/int.t/run.t | 3 +- 3 files changed, 30 insertions(+), 36 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 79c672f689..8860a8fbb5 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -605,16 +605,28 @@ struct Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) (Invariant.bot ()) ps - let of_interval e ik (x1, x2) = - if Z.equal x1 x2 then + let of_interval_opt e ik = function + | (Some x1, Some x2) when Z.equal x1 x2 -> of_int e ik x1 - else ( + | x1_opt, x2_opt -> let (min_ik, max_ik) = Size.range ik in let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = if inexact_type_bounds || Z.compare min_ik x1 <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) else Invariant.none in - let i2 = if inexact_type_bounds || Z.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) else Invariant.none in + let i1 = + match x1_opt, inexact_type_bounds with + | Some x1, false when Z.equal min_ik x1 -> Invariant.none + | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) + | None, _ -> Invariant.none + in + let i2 = + match x2_opt, inexact_type_bounds with + | Some x2, false when Z.equal x2 max_ik -> Invariant.none + | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) + | None, _ -> Invariant.none + in Invariant.(i1 && i2) - ) + + let of_interval e ik (x1, x2) = + of_interval_opt e ik (Some x1, Some x2) let of_excl_list e ik ns = List.fold_left (fun a x -> @@ -3778,7 +3790,7 @@ module IntDomTupleImpl = struct | Some v when not (GobConfig.get_bool "dbg.full-output") -> BatPrintf.fprintf f "\n\n%s\n\n\n" (Z.to_string v) | _ -> BatPrintf.fprintf f "\n\n%s\n\n\n" (show x) - let invariant_ikind e ik x = + let invariant_ikind e ik ((_, _, _, x_cong, x_intset) as x) = match to_int x with | Some v -> (* If definite, output single equality instead of every subdomain repeating same equality *) @@ -3788,10 +3800,15 @@ module IntDomTupleImpl = struct | Some ps -> IntInvariant.of_incl_list e ik ps | None -> - let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) - in List.fold_left (fun a i -> - Invariant.(a && i) - ) (Invariant.top ()) is + let min = minimal x in + let max = maximal x in + let ns = Option.map fst (to_excl_list x) |? [] in + Invariant.( + IntInvariant.of_interval_opt e ik (min, max) && + IntInvariant.of_excl_list e ik ns && + Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && + Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset + ) let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) diff --git a/tests/regression/cfg/foo.t/run.t b/tests/regression/cfg/foo.t/run.t index 02f6c1e5e0..705fb8d497 100644 --- a/tests/regression/cfg/foo.t/run.t +++ b/tests/regression/cfg/foo.t/run.t @@ -67,7 +67,7 @@ total lines: 6 [Warning][Deadcode][CWE-571] condition 'a > 0' (possibly inserted by CIL) is always true (foo.c:3:10-3:20) [Info][Witness] witness generation summary: - total generation entries: 15 + total generation entries: 13 $ yamlWitnessStrip < witness.yml - entry_type: loop_invariant @@ -125,17 +125,6 @@ string: 1 <= a type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 7 - column: 3 - function: main - location_invariant: - string: 0 <= a - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c @@ -224,14 +213,3 @@ string: 1 <= a type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 4 - column: 5 - function: main - location_invariant: - string: 0 <= a - type: assertion - format: C diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 6f75a2cd17..33316791e7 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -29,8 +29,7 @@ column: 5 function: main location_invariant: - string: (((0 <= i && i != 0) && (51 <= i && i <= 99)) && (0 <= i && i != 0)) && - (51 <= i && i <= 99) + string: (51 <= i && i <= 99) && ((i != 0 && i != 0) && (51 <= i && i <= 99)) type: assertion format: C - entry_type: location_invariant From 39f6c2d8d0d1c4f059263bba840fec4cb5aead34 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:41:09 +0300 Subject: [PATCH 104/107] Deduplicate inclusion list elements in IntDomTuple --- src/cdomain/value/cdomains/intDomain.ml | 2 +- tests/regression/witness/int.t/run.t | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 8860a8fbb5..c2eb2f3aa5 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3536,7 +3536,7 @@ module IntDomTupleImpl = struct let merge ps = let (vs, rs) = List.split ps in let (mins, maxs) = List.split rs in - (List.concat vs, (List.min mins, List.max maxs)) + (List.concat vs |> List.sort_uniq Z.compare, (List.min mins, List.max maxs)) in mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.to_excl_list } x |> flat merge diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 33316791e7..2bf5bd31c3 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -29,7 +29,7 @@ column: 5 function: main location_invariant: - string: (51 <= i && i <= 99) && ((i != 0 && i != 0) && (51 <= i && i <= 99)) + string: (51 <= i && i <= 99) && (i != 0 && (51 <= i && i <= 99)) type: assertion format: C - entry_type: location_invariant From 2408ab6ae413a4bfcefa149c5a76d086382e3f86 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:44:40 +0300 Subject: [PATCH 105/107] Filter out-of-invariant exclusion list elements in IntDomTuple invariant --- src/cdomain/value/cdomains/intDomain.ml | 2 ++ tests/regression/cfg/foo.t/run.t | 35 +------------------------ tests/regression/witness/int.t/run.t | 2 +- 3 files changed, 4 insertions(+), 35 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index c2eb2f3aa5..a472a5017e 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3803,6 +3803,8 @@ module IntDomTupleImpl = struct let min = minimal x in let max = maximal x in let ns = Option.map fst (to_excl_list x) |? [] in + let ns = Option.map_default (fun min -> List.filter (Z.leq min) ns) ns min in + let ns = Option.map_default (fun max -> List.filter (Z.geq max) ns) ns max in Invariant.( IntInvariant.of_interval_opt e ik (min, max) && IntInvariant.of_excl_list e ik ns && diff --git a/tests/regression/cfg/foo.t/run.t b/tests/regression/cfg/foo.t/run.t index 705fb8d497..cd890b7a19 100644 --- a/tests/regression/cfg/foo.t/run.t +++ b/tests/regression/cfg/foo.t/run.t @@ -67,7 +67,7 @@ total lines: 6 [Warning][Deadcode][CWE-571] condition 'a > 0' (possibly inserted by CIL) is always true (foo.c:3:10-3:20) [Info][Witness] witness generation summary: - total generation entries: 13 + total generation entries: 10 $ yamlWitnessStrip < witness.yml - entry_type: loop_invariant @@ -103,17 +103,6 @@ string: b == 0 type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 7 - column: 3 - function: main - location_invariant: - string: a != 0 - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c @@ -147,17 +136,6 @@ string: b != 0 type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 5 - column: 5 - function: main - location_invariant: - string: a != 1 - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c @@ -191,17 +169,6 @@ string: b != 0 type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 4 - column: 5 - function: main - location_invariant: - string: a != 0 - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 2bf5bd31c3..bc8ad5ac0a 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -29,7 +29,7 @@ column: 5 function: main location_invariant: - string: (51 <= i && i <= 99) && (i != 0 && (51 <= i && i <= 99)) + string: (51 <= i && i <= 99) && (51 <= i && i <= 99) type: assertion format: C - entry_type: location_invariant From 0a27c74d21a66a34abd5ecb6bbfe052d064fa261 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:57:06 +0300 Subject: [PATCH 106/107] Document nicer IntDomTuple invariant --- src/cdomain/value/cdomains/intDomain.ml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index a472a5017e..797c0f46c1 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3793,23 +3793,26 @@ module IntDomTupleImpl = struct let invariant_ikind e ik ((_, _, _, x_cong, x_intset) as x) = match to_int x with | Some v -> - (* If definite, output single equality instead of every subdomain repeating same equality *) + (* If definite, output single equality instead of every subdomain repeating same equality (or something less precise). *) IntInvariant.of_int e ik v | None -> match to_incl_list x with | Some ps -> + (* If inclusion set, output disjunction of equalities because it subsumes interval(s), exclusion set and congruence. *) IntInvariant.of_incl_list e ik ps | None -> + (* Get interval bounds from all domains (intervals and exclusion set ranges). *) let min = minimal x in let max = maximal x in - let ns = Option.map fst (to_excl_list x) |? [] in + let ns = Option.map fst (to_excl_list x) |? [] in (* Ignore exclusion set bit range, known via interval bounds already. *) + (* "Refine" out-of-bounds exclusions for simpler output. *) let ns = Option.map_default (fun min -> List.filter (Z.leq min) ns) ns min in let ns = Option.map_default (fun max -> List.filter (Z.geq max) ns) ns max in Invariant.( - IntInvariant.of_interval_opt e ik (min, max) && + IntInvariant.of_interval_opt e ik (min, max) && (* Output best interval bounds once instead of multiple subdomains repeating them (or less precise ones). *) IntInvariant.of_excl_list e ik ns && - Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && - Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset + Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && (* Output congruence as is. *) + Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset (* Output interval sets as is. *) ) let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) From 02ef2f96d96e15bf94231dfdc5ddebe7b6d3606b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:59:08 +0300 Subject: [PATCH 107/107] Disable interval set in witness int invariant cram test --- tests/regression/witness/int.t/run.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index bc8ad5ac0a..6b4784ce32 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --enable witness.yaml.enabled --set witness.yaml.entry-types '["location_invariant"]' --enable ana.int.def_exc --enable ana.int.enums --enable ana.int.interval --enable ana.int.congruence --enable ana.int.interval_set --disable witness.invariant.split-conjunction int.c + $ goblint --enable ana.sv-comp.functions --enable witness.yaml.enabled --set witness.yaml.entry-types '["location_invariant"]' --enable ana.int.def_exc --enable ana.int.enums --enable ana.int.interval --enable ana.int.congruence --disable ana.int.interval_set --disable witness.invariant.split-conjunction int.c [Success][Assert] Assertion "1" will succeed (int.c:9:5-9:23) [Success][Assert] Assertion "1" will succeed (int.c:12:5-12:23) [Success][Assert] Assertion "1" will succeed (int.c:15:5-15:23) @@ -29,7 +29,7 @@ column: 5 function: main location_invariant: - string: (51 <= i && i <= 99) && (51 <= i && i <= 99) + string: 51 <= i && i <= 99 type: assertion format: C - entry_type: location_invariant @@ -40,6 +40,6 @@ column: 5 function: main location_invariant: - string: i <= 99 && i <= 99 + string: i <= 99 type: assertion format: C